'tinytea.tea is an interpreter of the Teapro programming language
'In today's world, we need computer software that actually works.
vari dg_pass1, dg_pass2, dg_pass3
vari sg_pass1, sg_pass2, sg_pass3
vari sg_build, sg_nothing, dg_more
vari dg_xvalue, dg_yvalue, dg_zvalue, sg_xyzmath
'below for sub_all_teapro_commands_test0 etc
vari dg_errorct, sg_numbers, sg_alphanum, dg_step
sub_main
endp
subr sub_main
'updated 2008/02/23
'2008/01/24, 2007/11/12, 2007/07/17, 2007/04/11, 2007/03/01
'2007/02/24, 2006/11/29, 2006/09/23, 2006/09/04, 2006/08/03
'2006/04/19, 2006/03/03, 2005/10/15, 2005/10/12, 2005/08/23
'2005/07/21, 2005/07/02, 2005/06/15, 2005/06/07, 2005/06/05
'2005/05/17, 2005/05/06, 2005/05/02, 2005/05/01, 2005/03/31
'2005/03/29, 2005/03/16, 2005/03/13, 2005/02/24, 2005/02/15
'2005/02/13, 2005/02/12, 2005/02/09, 2004/11/14
vari s_any, d_any, s_dot, d_dot, s_out, s_aster
vari d_loop, s_pick, d_pick
sg_nothing = " "
$trb sg_nothing, sg_nothing
$ch$ s_aster, "*", 70
d_loop = 1
dwhi d_loop = 1
sg_build = "Program: tinytea.tea, build=367, 2008/02/25"
$out sg_build
$out "Copyright (c) 2004-2008 by D La Pierre Ballard"
$out "tinytea.tea was begun on 2004/11/14"
$out "This computer program tinytea.tea may be used"
$out "for free by anyone, but there is no warranty"
$out "of any kind whatsoever on tinytea.tea."
$out s_aster
$out "The OpenTea technology makes Teapro simple and solid."
$out s_aster
s_any = "In today's world, we need computer software"
$app s_any, " that actually works."
$out s_any
$out s_aster
sub_path_prog_memory
$dat sg_pass1
$out sg_pass1
dsec dg_pass1
$out "seconds=" + dg_pass1
$sys s_any, 3
$out s_any
$out sg_build
sub_speedquick
$out s_aster
$out "1. teaquad 5TP39 find by modulus, begin again"
$out "2. teaquad 5TP39 find by modulus"
$out "3. 5TP39 find simple slow"
$out "12. sub_teaquad_primes_find"
$out "13. sub_teaquad_primes_test_one_number"
$out "14. prime gaps simple"
$out "15. prime gaps dfac fast"
$out "24. 5TP39 validate in file"
$out "25. sub_teaquad_5tp39_test_a_number"
$out "26. Quad primes"
$out "27. 5TP39s compare two files"
$out "31. test various commands"
$out "32. test all teapro commands"
$out "33. test all teapro commands step"
$out "34. test big strings"
$out "37. sub_test_beyond_limits"
$out "41. sub_test_arithmetic"
$out "51. recursion test"
$out "61. floating point accuracy test"
$out "96. xyz math"
$out "97. sub_teaquad_prime_speed_test"
$out "98. sub_speed98_test"
$out "99. sub_speed_test " + dg_pass1
s_out = "pick a number *=end" + " x=" + dg_xvalue
$inp s_pick, s_out
d_pick = 0
$isd d_any, s_pick
dift d_any = 1: $tod d_pick, s_pick
'asterisk is char 42
$ift s_pick = "*": d_loop = 2
'5tp39 find by modulus begin again
dift d_pick = 1
dg_pass1 = 2
sub_teaquad_5tp39_by_modulus
endi
'5tp39 find by modulus
dift d_pick = 2
dg_pass1 = 1
sub_teaquad_5tp39_by_modulus
endi
'5tp39s find simple
dift d_pick = 3: sub_5tp39_find_simple_slow
'prime numbers
dift d_pick = 12: sub_teaquad_primes_find
'test one number
dift d_pick = 13: sub_teaquad_primes_test_one_number
'prime gaps
dift d_pick = 14: sub_prime_gaps_simple
'prime gaps
dift d_pick = 15: sub_prime_gaps_dfac
'5TP39 validate in file
dift d_pick = 24: sub_5tp39_validate_in_file
'5TP39 test a number
dift d_pick = 25: sub_teaquad_5tp39_test_a_number
'Quad primes
dift d_pick = 26: sub_quad_primes
'5TP39s compare two files
dift d_pick = 27: sub_5TP39_two_files_compare
'command test
dift d_pick = 31: sub_command_test
'all string commands test
dift d_pick = 32
dg_pass1 = 2
sub_all_teapro_commands_test0
endi
'all string commands test step
dift d_pick = 33
dg_pass1 = 1
sub_all_teapro_commands_test0
endi
'test big strings
dift d_pick = 34: sub_test_big_strings
'test beyond limits
dift d_pick =37: sub_test_beyond_limits
'test arithmetic
dift d_pick = 41: sub_test_arithmetic
dift d_pick = 51
'recursion test
$inp s_any, "enter a number for depth"
d_dot = 0
$isd d_any, s_any
dift d_any = 1: $tod d_dot, s_any
dg_pass1 = d_dot
sub_recursion
endi
'floating point accuracy test
dift d_pick = 61: sub_floating_point_accuracy
dift d_pick = 96
sg_pass1 = "x=x"
sub_xyz_math
endi
'prime speed test
dift d_pick = 97: sub_teaquad_prime_speed_test
'speed98 test
dift d_pick = 98: sub_speed98_test
'speed test
dift d_pick = 99: sub_speed_test
sg_pass1 = s_pick
sub_xyz_math
s_pick = sg_pass1
endw
ends sub_main
subr sub_prime_gaps_simple
'updated 2006/05/20, 2006/05/09, 2006/05/03, 2006/05/01, 2006/04/18
'2006/04/17, 2006/04/16, 2005/03/31, 2005/02/23, 2005/02/19
vari s_any, d_any, s_dot, d_dot, s_out
vari d_yesfile, s_filename, d_number, d_tofindct, d_count
vari s_date, s_prevhour, d_prevhour, d_factor, d_yesdfac
vari d_gap, d_maxgap, d_prevprime, d_pause, d_loop
vari d_process, d_seconds1, d_seconds2, s_seconds
$sys s_any, 2
$out s_any
d_process = 1
dift d_process = 1
$inp s_any, "1 = pause after each"
$ift s_any = "*": dinc d_process
d_pause = 2
$isd d_any, s_any
dift d_any = 1: $tod d_pause, s_any
endi
dift d_process = 1
$out "12345678901234567890"
$inp s_any, "enter number to start with"
$ift s_any = "*": dinc d_process
d_number = 3
$isd d_any, s_any
dift d_any = 1: $tod d_number, s_any
endi
dift d_process = 1
$inp s_any, "enter max gap so far"
$ift s_any = "*": dinc d_process
d_maxgap = 2
$isd d_any, s_any
dift d_any = 1: $tod d_maxgap, s_any
endi
dift d_process = 1
ded$ s_any, d_number, 0, 0
$out "number entered=" + s_any
$out "begin gap=" + d_maxgap
'make sure number is odd and an integer
d_number = d_number \ 1
d_any = d_number % 2
dift d_any = 0: d_number = d_number + 1
s_prevhour = "99"
ded$ s_any, d_number, 0, 0
$out "begin=" + s_any
$out "gap=" + d_maxgap
$out "d_yesdfac=" + d_yesdfac
'd_prevprime is for previous prime
d_prevprime = d_number
d_number = d_number + 2
endi
'd_count is for counting the primes
d_count = 0
'is count d_count still less than total wanted d_tofindct
dsec d_seconds1
d_loop = d_process
dwhi d_loop = 1
dg_pass1 = d_number
sub_prime_test_simple
d_factor = dg_pass1
dift d_factor = 1
'd_number is prime
$sho d_number
'increment count d_count
d_count = d_count + 1
'find difference with previous in d_prevprime
d_gap = d_number - d_prevprime
dift d_gap >= d_maxgap
dsec d_seconds2
d_any = d_seconds2 - d_seconds1
dto$ s_seconds, d_any, 0, 3
d_maxgap = d_gap
ded$ s_any, d_prevprime, 0, 0
s_out = d_count + ". prime=" + s_any
$app s_out, ", gap=" + d_gap
$app s_out, ", max=" + d_maxgap
$app s_out, ", sec=" + s_seconds
$out s_out
dift d_pause = 1
$inp s_any, "return, go=go, * to end"
$ift s_any = "*": d_loop = 2
$tup s_any, s_any
$ift s_any = "GO": dinc d_pause
endi
d_seconds1 = d_seconds2
endi
'save to d_time1 for previous prime
d_prevprime = d_number
endi
'next number to test
d_number = d_number + 2
endw
ends sub_prime_gaps_simple
subr sub_prime_gaps_dfac
'updated 2006/05/20, 2006/04/19, 2006/04/18
'2006/04/17, 2006/04/16, 2005/03/31, 2005/02/23, 2005/02/19
vari s_any, d_any, s_dot, d_dot, s_out
vari d_yesfile, s_filename1, s_filename2
vari d_number, d_prevprime, d_factor
vari s_date, s_prevhour, d_prevhourprime
vari d_gap, d_maxgap, d_loop
vari d_process, d_halfmax
vari d_sec1, d_sec2, d_sec3
$sys s_any, 2
$out s_any
d_process = 1
dift d_process = 1
$inp s_any, "1 = append to files GAPS1.TXT,GAPS2.TXT"
$ift s_any = "*": dinc d_process
d_yesfile = 2
$isd d_any, s_any
dift d_any = 1: $tod d_yesfile, s_any
s_filename1 = "gaps1.txt"
s_filename2 = "gaps2.txt"
endi
dift d_process = 1
$out "12345678901234567890"
$inp s_any, "enter number to start with"
$ift s_any = "*": dinc d_process
d_number = 3
$isd d_any, s_any
dift d_any = 1: $tod d_number, s_any
endi
dift d_process = 1
$inp s_any, "enter max gap so far"
$ift s_any = "*": dinc d_process
d_maxgap = 2
$isd d_any, s_any
dift d_any = 1: $tod d_maxgap, s_any
endi
dift d_process = 1
ded$ s_any, d_number, 0, 0
$out "number entered=" + s_any
$out "begin gap=" + d_maxgap
'make sure number is odd and an integer
d_number = d_number \ 1
d_any = d_number % 2
dift d_any = 0: d_number = d_number + 1
s_prevhour = "99"
ded$ s_any, d_number, 0, 0
$out "begin=" + s_any
$out "gap=" + d_maxgap
d_halfmax = d_maxgap \ 2
'd_prevprime is for previous prime
d_prevprime = d_number
endi
dsec d_sec1
d_loop = d_process
dwhi d_loop = 1
'next number to test
d_number = d_number + 2
dfac d_factor, d_number
dwhi d_factor <> 1
'next number to test
d_number = d_number + 2
dfac d_factor, d_number
endw
'd_number is prime
'find difference with previous in d_prevprime
d_gap = d_number - d_prevprime
dift d_gap >= d_maxgap
dsec d_sec2
d_sec3 = d_sec2 - d_sec1
d_sec1 = d_sec2
$dat s_date
$cut s_date, s_date, 1, 20
d_maxgap = d_gap
d_halfmax = d_maxgap \ 2
ded$ s_any, d_prevprime, 0, 0
s_out = "prime=" + s_any
$app s_out, " gap=" + d_gap
$app s_out, " max=" + d_maxgap
$app s_out, " dat=" + s_date
$app s_out, " sec=" + d_sec3
$out s_out
'do we save to file s_filename
dift d_yesfile = 1
fapp d_any, s_filename1, s_out
dbad d_any = 0
fapp d_any, s_filename2, s_out
dbad d_any = 0
endi
endi
d_prevprime = d_number
dift d_gap > d_halfmax
$sho d_number
'12345678901234567890
'23-FEB-2005 08:25:03
$dat s_date
$cut s_any, s_date, 13, 2
$ift s_any <> s_prevhour
s_prevhour = s_any
$cut s_date, s_date, 1, 20
d_dot = d_prevprime - d_prevhourprime
ded$ s_dot, d_dot, 0, 0
d_prevhourprime = d_prevprime
ded$ s_any, d_prevprime, 0, 0
s_out = s_any + " " + "max=" + d_maxgap
$app s_out, " " + s_date + " " + s_dot
$out s_out
'do we save to file s_filename
dift d_yesfile = 1
fapp d_any, s_filename1, s_out
dbad d_any = 0
endi
endi
endi
endw
ends sub_prime_gaps_dfac
subr sub_5tp39_find_simple_slow
'updated 2006/09/04, 2005/03/31, 2005/02/25, 2005/02/18
'2005/02/17, 2005/02/10, 2005/02/09, 2004/11/29
'find 5tp39
vari d_any, s_any, d_dot, s_dot, s_out
vari d_loop, d_number
vari d_try, d_result, s_filename
vari s_hour, s_dateline, d_beghour
$sys s_any, 2
$out s_any
'd_loop is loop
d_loop = 1
$out "enter starting number"
$inp s_any, "123456789012345678901"
$ift s_any = "*": d_loop = 2
d_number = 1
$isd d_any, s_any
dift d_any = 1: $tod d_number, s_any
$inp s_filename, "enter output filename"
$ift s_filename = "*": d_loop = 2
'get a proper PIVCOM
'PIVCOM named by Roger Hargrave in 2002
d_any = d_number \ 210 * 210
dift d_any < 210: d_any = d_any + 210
'get a proper beginning number for 5TP39
d_number = d_any - 19
ded$ s_any, d_number, 0, 0
$out "begin=" + s_any
s_hour = "aa"
d_beghour = d_number
dwhi d_loop = 1
'test d_number for 5TP39
'almost 5TP39=11,13,17,19,29,31,41,43,47,49
dfac d_result, d_number
dift d_result = 1
d_try = d_number + 2
dfac d_result, d_try
dift d_result = 1
ded$ s_any, d_number, 0, 0
$dat s_dateline
$cut s_dateline, s_dateline, 1, 20
$sho s_any + " " + s_dateline
$cut s_any, s_dateline, 13, 2
$ift s_any <> s_hour
s_hour = s_any
d_any = d_number - d_beghour
ded$ s_any, d_any, 0, 0
ded$ s_out, d_number, 0, 0
$app s_out, " " + s_dateline + ", hr=" + s_any
$out s_out
fapp d_any, s_filename, s_out
dbad d_any = 0
d_beghour = d_number
endi
d_try = d_number + 6
dfac d_result, d_try
dift d_result = 1
d_try = d_number + 8
dfac d_result, d_try
dift d_result = 1
d_try = d_number + 18
dfac d_result, d_try
dift d_result = 1
d_try = d_number + 20
dfac d_result, d_try
dift d_result = 1
d_try = d_number + 30
dfac d_result, d_try
dift d_result = 1
d_try = d_number + 32
dfac d_result, d_try
dift d_result = 1
d_try = d_number + 36
dfac d_result, d_try
dift d_result = 1
d_try = d_number + 38
dfac d_result, d_try
dift d_result = 1
$dat s_dot
$cut s_dot, s_dot, 1, 20
ded$ s_any, d_number, 0, 0
s_out = "] 000:5TP39= " + s_any + " " + s_dot
$out s_out
fapp d_any, s_filename, s_out
dbad d_any = 0
endi
endi
endi
endi
endi
endi
endi
endi
endi
endi
d_number = d_number + 210
endw
$inp s_any,"return"
ends sub_5tp39_find_simple_slow
subr sub_teaquad_5tp39_by_modulus
'updated 2007/02/24, 2007/02/22, 2007/01/27, 2007/01/11
'2006/12/21, 2006/12/12, 2006/11/30, 2006/11/24, 2006/11/19
'2006/11/18, 2006/11/16, 2006/11/12, 2006/10/29, 2006/10/27
'2006/10/26, 2006/10/12, 2006/09/30, 2006/09/28, 2006/09/04
'2006/08/22, 2006/08/17, 2006/07/27, 2006/07/23, 2006/07/06
'2006/05/23, 2006/04/23, 2006/03/14, 2006/03/13, 2006/02/27
'2006/02/24, 2006/01/29, 2005/11/29, 2005/08/07, 2005/06/11
'2005/06/07, 2005/06/05, 2005/05/31, 2005/05/17, 2005/05/16
'2005/05/14, 2005/05/11, 2005/05/06, 2005/05/02, 2005/04/29
'2005/04/27, 2005/04/24, 2005/04/23, 2005/04/04, 2005/04/02
'2005/03/31, 2005/03/21, 2005/03/14, 2005/03/10, 2005/03/09
'2005/03/08, 2005/03/03, 2005/03/02, 2005/02/27, 2005/02/24
'find 5TP39s by modulus
'dg_pass=1=d_which means must enter beginning number
'dg_pass=2=d_which means begin again from number in file
vari d_any, s_any, d_dot, s_dot, s_out
vari d_good, s_date, s_timehournew, s_timehourold, s_begdate
vari d_primetest, s_primetest, d_maxprimetest, d_begin
vari d_hourprimetest, s_billperhr, s_trillperday
vari d_billperhr, d_trillperday
vari d_trillion, d_billion
vari d_ctbillphr, d_totperperiod
vari d_pivcom, s_pivcom, d_modulus, d_process
vari d_number, s_number, d_index, d_maxindex, d_divisor
vari d_filebyte, d_loop, s_record, s_file5tp39
vari s_afile, s_bfile, d_long, d_which
vari d_11mod, d_13mod, d_maxnumber
vari d_teaquadnum, d_mod1, d_mod2, d_mod3
vari d_teaquadpart, d_teaquadmult
'd_which=1 for enter beginning number and file code
'd_which=2 for begin again get number from file
d_which = dg_pass1
$sys s_any, 2
$out s_any
d_process = 1
dpow d_teaquadnum, 10, 15
d_teaquadmult = 1
dpow d_trillion, 10, 12
dpow d_billion, 10, 9
$dat s_begdate
d_ctbillphr = 0
d_totperperiod = 0
d_maxindex = 2000
'which filename do we want in s_afile
'home1 office computer has s_afile = "a5tp39h1.txt"
s_afile = "a5tp39h1.txt"
s_bfile = "b5tp39h1.txt"
flen d_long, s_afile
dift d_long < 0
'home2 office computer has s_afile = "a5tp39h2.txt"
s_afile = "a5tp39h2.txt"
s_bfile = "b5tp39h2.txt"
flen d_long, s_afile
endi
dift d_long < 0
'home3 office computer has s_afile = "a5tp39h3.txt"
s_afile = "a5tp39h3.txt"
s_bfile = "b5tp39h3.txt"
flen d_long, s_afile
endi
dift d_long < 0
'work D's computer has s_afile = "a5tp39d1.txt"
s_afile = "a5tp39d1.txt"
s_bfile = "b5tp39d1.txt"
flen d_long, s_afile
endi
dift d_long < 0
'work D's computer has s_afile = "a5tp39d2.txt"
s_afile = "a5tp39d2.txt"
s_bfile = "b5tp39d2.txt"
flen d_long, s_afile
endi
dift d_long < 0
'work D's computer has s_afile = "a5tp39d3.txt"
s_afile = "a5tp39d3.txt"
s_bfile = "b5tp39d3.txt"
flen d_long, s_afile
endi
dift d_long < 0
'home A's computer has s_afile = "a5tp39a1.txt"
s_afile = "a5tp39a1.txt"
s_bfile = "b5tp39a1.txt"
flen d_long, s_afile
endi
dift d_long < 0
'home A's computer has s_afile = "a5tp39a2.txt"
s_afile = "a5tp39a2.txt"
s_bfile = "b5tp39a2.txt"
flen d_long, s_afile
endi
dift d_long < 0
'work Linux computer has s_afile = "a5tp39x1.txt"
s_afile = "a5tp39x1.txt"
s_bfile = "b5tp39x1.txt"
flen d_long, s_afile
endi
dift d_long < 0
'work Linux computer has s_afile = "a5tp39x2.txt"
s_afile = "a5tp39x2.txt"
s_bfile = "b5tp39x2.txt"
flen d_long, s_afile
endi
dift d_long < 0
'work R's computer has s_afile = "a5tp39r1.txt"
s_afile = "a5tp39r1.txt"
s_bfile = "b5tp39r1.txt"
flen d_long, s_afile
endi
dift d_long < 0
'work R's computer has s_afile = "a5tp39r2.txt"
s_afile = "a5tp39r2.txt"
s_bfile = "b5tp39r2.txt"
flen d_long, s_afile
endi
dift d_long < 0
'notebook computer Alice has s_afile = "a5tp39n1.txt"
s_afile = "a5tp39n1.txt"
s_bfile = "b5tp39n1.txt"
flen d_long, s_afile
endi
dift d_long < 0
'notebook computer Alice has s_afile = "a5tp39n2.txt"
s_afile = "a5tp39n2.txt"
s_bfile = "b5tp39n2.txt"
flen d_long, s_afile
endi
dift d_long < 0
'notebook computer Scotty has s_afile = "a5tp39n3.txt"
s_afile = "a5tp39n3.txt"
s_bfile = "b5tp39n3.txt"
flen d_long, s_afile
endi
dift d_long < 0
'notebook computer Scotty has s_afile = "a5tp39n4.txt"
s_afile = "a5tp39n4.txt"
s_bfile = "b5tp39n4.txt"
flen d_long, s_afile
endi
dift d_long < 0
'super1 has s_afile = "a5tp39s1.txt"
s_afile = "a5tp39s1.txt"
s_bfile = "b5tp39s1.txt"
flen d_long, s_afile
endi
dift d_long < 0
'super2 has s_afile = "a5tp39s2.txt"
s_afile = "a5tp39s2.txt"
s_bfile = "b5tp39s2.txt"
flen d_long, s_afile
endi
dift d_long < 0
'super3 has s_afile = "a5tp39s3.txt"
s_afile = "a5tp39s3.txt"
s_bfile = "b5tp39s3.txt"
flen d_long, s_afile
endi
dift d_long < 0
'super4 has s_afile = "a5tp39s4.txt"
s_afile = "a5tp39s4.txt"
s_bfile = "b5tp39s4.txt"
flen d_long, s_afile
endi
dift d_long < 0
'super5 has s_afile = "a5tp39s5.txt"
s_afile = "a5tp39s5.txt"
s_bfile = "b5tp39s5.txt"
flen d_long, s_afile
endi
dift d_long < 0
'super6 has s_afile = "a5tp39s6.txt"
s_afile = "a5tp39s6.txt"
s_bfile = "b5tp39s6.txt"
flen d_long, s_afile
endi
'd_which=1 for enter beginning number and file code
'd_which=2 for begin again get number from file
d_dot = 2
dift d_which = 1: d_dot = 1
dift d_long < 0
d_dot = 1
s_afile = "a5tp39zz.txt"
s_bfile = "b5tp39zz.txt"
endi
dift d_dot = 1
s_any = "ie. d1,d2,d3,h1,h2,h3,"
$app s_any, "a1,a2,r1,r2,n1,n2,n3,x1,x2"
$app s_any, "s1,s2,s3,s4,s5,s6"
$out s_any
$out "default files=" + s_afile + " and " + s_bfile
s_any = "enter different two letter file code, "
$app s_any, "return for default"
$inp s_any, s_any
$ift s_any = "*": dinc d_process
$tlo s_any, s_any
$len d_any, s_any
dift d_any = 2
s_afile = "a5tp39" + s_any + ".txt"
s_bfile = "b5tp39" + s_any + ".txt"
endi
dift d_process <> 1: d_which = 100
endi
dift d_process = 1
'get beginning number from file
d_begin = 0
d_filebyte = 1
d_loop = 1
dwhi d_loop = 1
fsip s_record, s_afile, d_filebyte
dift d_filebyte = 0
dinc d_loop
else
$trb s_record, s_record
$app s_record, " "
$lok d_any, s_record, 1, " "
$cut s_any, s_record, 1, d_any
sg_pass1 = s_any
sub_teaquad_from_string
d_dot = 2
dift dg_pass1 > 0: d_dot = 1
dift dg_pass2 > 0: d_dot = 1
dift d_dot = 1
d_teaquadpart = dg_pass1
d_teaquadmult = dg_pass2
endi
endi
endw
dift d_teaquadpart = 0: d_which = 1
endi
dift d_which = 1
$out "files=" + s_afile + " and " + s_bfile
'enter beginning number
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
sub_teaquad_to_string
s_number = sg_pass1
$out "default beginning 9quad number=" + s_number
$out "9quad beginning number"
$inp s_any, "12345678901234567890123, return for default"
$ift s_any = "*": dinc d_process
$trb s_any, s_any
$len d_any, s_any
dift d_any > 0
sg_pass1 = s_any
sub_teaquad_from_string
d_teaquadpart = dg_pass1
d_teaquadmult = dg_pass2
endi
endi
dift d_process = 1
$out "files=" + s_afile + " and " + s_bfile
'the term PIVCOM was invented by Roger Hargrave in 2002
'find d_pivcom for 9quad d_begin
d_mod1 = d_teaquadpart % 210
d_mod2 = d_teaquadnum % 210 * d_teaquadmult
d_mod3 = d_mod1 + d_mod2 % 210
d_teaquadpart = d_teaquadpart - d_mod3
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
sub_teaquad_to_string
s_pivcom = sg_pass1
'find the place to begin
d_teaquadpart = d_teaquadpart - 19
'output beginning numbers to file
$dat s_date
$cut s_date, s_date, 1, 20
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
sub_teaquad_to_string
s_number = sg_pass1
s_out = "begin=" + s_number + " " + s_date
$app s_out, " " + s_afile
$out s_out
fapp d_any, s_afile, s_out
dbad d_any = 0
'put d_maxindex primes in decimal array
d_number = 17
d_index = 1
dwhi d_index <= d_maxindex
d_modulus = 9999
dwhi d_modulus > 1
dfac d_modulus, d_number
dift d_modulus > 1: d_number = d_number + 2
endw
dtoi d_index, d_number
d_number = d_number + 2
dinc d_index
endw
s_timehourold = "x"
d_hourprimetest = d_primetest
dpow d_any, 10, 14
d_maxnumber = d_any + d_teaquadpart + 1000 \ d_any * d_any
dg_pass1 = d_maxnumber
dg_pass2 = d_teaquadmult
sub_teaquad_to_string
s_number = sg_pass1
$out "maxnumber=" + s_number
endi
d_teaquadpart = d_teaquadpart - 210
'19 and 41 are the same for 11: 19+22=41
'0=11,1=43,2=31,3=19,4=29,5=17,6=49,7=N,8=47,9=13,10=N
'so 11 gives 7,10
'11,13,17,19,29,31,41,43,47,49
dift d_process = 1
dwhi 1 = 1
'increment d_primetest = first prime
d_loop = 1
dwhi d_loop = 1
d_teaquadpart = d_teaquadpart + 210
'teaquad = d_teaquadnum = 1E15
'd_11mod must be 7 or 10 for d_teaquadpart good
'teaquad % 11 = 10
d_any = 10 * d_teaquadmult
d_11mod = d_teaquadpart % 11 + d_any % 11
'd_13mod must be 2, 4, 10, or 12 for d_teaquadpart good
'teaquad % 13 = 12
d_any = 12 * d_teaquadmult
d_13mod = d_teaquadpart % 13 + d_any % 13
dift d_11mod = 7
dift d_13mod = 2
dinc d_loop
else
dift d_13mod = 4
dinc d_loop
else
dift d_13mod = 10
dinc d_loop
else
dift d_13mod = 12: dinc d_loop
endi
endi
endi
else
dift d_11mod = 10
dift d_13mod = 2
dinc d_loop
else
dift d_13mod = 4
dinc d_loop
else
dift d_13mod = 10
dinc d_loop
else
dift d_13mod = 12: dinc d_loop
endi
endi
endi
endi
endi
endw
'17 is in index=1
d_index = 1
d_maxprimetest = d_teaquadpart + 38
dwhi d_index <= d_maxindex
itod d_divisor, d_index
d_any = d_maxprimetest % d_divisor
d_modulus = d_teaquadnum % d_divisor * d_teaquadmult + d_any % d_divisor
dift d_modulus < 39
dift d_modulus = 0
d_index = 9999
else
dift d_modulus = 2
d_index = 9999
else
dift d_modulus = 6
d_index = 9999
else
dift d_modulus = 8
d_index = 9999
else
dift d_modulus = 18
d_index = 9999
else
dift d_modulus = 20
d_index = 9999
else
dift d_modulus = 30
d_index = 9999
else
dift d_modulus = 32
d_index = 9999
else
dift d_modulus = 36
d_index = 9999
else
dift d_modulus = 38
d_index = 9999
endi
endi
endi
endi
endi
endi
endi
endi
endi
endi
endi
dinc d_index
endw
d_good = 2
dift d_index < 9999: dfak d_good, d_teaquadpart, d_teaquadmult
dift d_good = 1
'9quad d_teaquadpart is prime
'12345678901234567890123456789012345
'17-DEC-2002 03:56:22 20021217035622
$dat s_date
$cut s_date, s_date, 1, 20
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
sub_teaquad_to_string
s_primetest = sg_pass1
s_out = s_primetest + " " + s_date
$sho s_out
'get second digit of the hour for below
$cut s_timehournew, s_date, 14, 1
'have we hit the max
dift d_teaquadpart > d_maxnumber: s_timehourold = "x"
$ift s_timehournew <> s_timehourold
s_timehourold = s_timehournew
'get perhr change
d_dot = d_teaquadpart - d_hourprimetest
d_hourprimetest = d_teaquadpart
d_billperhr = d_dot / d_billion
'd_ctbillphr begins at 0
dinc d_ctbillphr
dift d_ctbillphr < 3: d_billperhr = 0
'skip first two times
dift d_ctbillphr > 2
'd_totperperiod is the total for 12 hours
d_dot = d_ctbillphr - 2
dift d_dot <= 12
'if d_dot is 1..12 to total for 12 hrs
d_totperperiod = d_totperperiod + d_billperhr
'find average per hour
d_any = d_totperperiod / d_dot
'show based on 24 hour day
d_trillperday = d_any * 24 / 1000
else
'if d_dot > 12
d_any = d_totperperiod / 12 * 11
d_totperperiod = d_billperhr + d_any
'find average per hour
d_any = d_totperperiod / 12
'show based on 24 hour day
d_trillperday = d_any * 24 / 1000
endi
endi
dto$ s_billperhr, d_billperhr, 5, 1
$trb s_billperhr, s_billperhr
s_billperhr = " bph=" + s_billperhr
$app s_out, s_billperhr
dto$ s_trillperday, d_trillperday, 5, 2
$trb s_trillperday, s_trillperday
$app s_out, " tpd=" + s_trillperday
fapp d_any, s_afile, s_out
dbad d_any = 0
$out s_out
dift d_teaquadpart > d_maxnumber
sub_path_prog_memory
$inp s_any, "at max, begin=" + s_begdate
endp
endi
endi
'is d_teaquadpart + 2 a prime
d_any = d_teaquadpart + 2
dfak d_good, d_any, d_teaquadmult
dift d_good = 1
'is d_teaquadpart + 6 a prime
d_any = d_teaquadpart + 6
dfak d_good, d_any, d_teaquadmult
dift d_good = 1
'is d_teaquadpart + 8 a prime
d_any = d_teaquadpart + 8
dfak d_good, d_any, d_teaquadmult
dift d_good = 1
'is d_teaquadpart + 18 a prime
d_any = d_teaquadpart + 18
dfak d_good, d_any, d_teaquadmult
dift d_good = 1
'is d_teaquadpart + 20 a prime
d_any = d_teaquadpart + 20
dfak d_good, d_any, d_teaquadmult
dift d_good = 1
'is d_teaquadpart + 30 a prime
d_any = d_teaquadpart + 30
dfak d_good, d_any, d_teaquadmult
dift d_good = 1
'is d_teaquadpart + 32 a prime
d_any = d_teaquadpart + 32
dfak d_good, d_any, d_teaquadmult
dift d_good = 1
'is d_teaquadpart + 36 a prime
d_any = d_teaquadpart + 36
dfak d_good, d_any, d_teaquadmult
dift d_good = 1
'is d_teaquadpart + 38 a prime
d_any = d_teaquadpart + 38
dfak d_good, d_any, d_teaquadmult
dift d_good = 1
'we have a 9quad 5TP39
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
sub_teaquad_to_string
s_primetest = sg_pass1
'show the just found 5TP39
$dat s_date
$cut s_date, s_date, 1, 20
s_out = "] 000:5TP39= " + s_primetest
$app s_out, " " + s_date
$out s_out
fapp d_any, s_afile, s_out
dbad d_any = 0
fapp d_any, s_bfile, s_out
dbad d_any = 0
fapp d_any, s_afile, s_primetest
dbad d_any = 0
endi
endi
endi
endi
endi
endi
endi
endi
endi
endi
endw
endi
ends sub_teaquad_5tp39_by_modulus
subr sub_teaquad_primes_test_one_number
'updated 2007/02/26, 2007/02/25, 2007/02/24, 2006/12/06
'2006/11/15, 2006/11/14, 2006/11/12, 2006/11/11, 2006/10/25
'primes 9quad greater than 9E15 as total of two numbers
vari d_any, s_any, d_dot, s_dot, s_out
vari d_teaquadpart, d_factor, d_seconds, s_input
vari d_process, d_teaquadnum, d_teaquadmult, s_default
dpow d_teaquadnum, 10, 15
d_process = 1
dift d_process = 1
$out "1. 999,999,999,999,999,989"
$out "2. 108,000,000,000,000,001"
$out "11. 6,000,000,000,000,001"
$out "21. 600,000,000,000,000,000,001"
$inp s_input, "choose or enter number to test"
$ift s_input = "*": dinc d_process
$ift s_input = "1": s_input = "999,999,999,999,999,989"
$ift s_input = "2": s_input = "108,000,000,000,000,001"
$ift s_input = "11": s_input = "6,000,000,000,000,001"
$ift s_input = "21": s_input = "600,000,000,000,000,000,001"
endi
dift d_process = 1
$out s_input
sg_pass1 = s_input
sub_teaquad_from_string
d_teaquadpart = dg_pass1
d_teaquadmult = dg_pass2
ded$ s_any, d_teaquadpart, 0, 0
$out "d_teaquadpart=" + s_any
ded$ s_any, d_teaquadmult, 0, 0
$out "d_teaquadmult=" + s_any
endi
dift d_process = 1
dsec d_seconds
dfak d_factor, d_teaquadpart, d_teaquadmult
dsec d_any
d_seconds = d_any - d_seconds
$out "seconds=" + d_seconds
ded$ s_any, d_teaquadpart, 0, 0
$out "d_teaquadpart=" + s_any
ded$ s_any, d_teaquadmult, 0, 0
$out "d_teaquadmult=" + s_any
ded$ s_any, d_factor, 0, 0
$out "d_factor=" + s_any
endi
$inp s_any, "done"
ends sub_teaquad_primes_test_one_number
subr sub_9quad_primes_test_one_number
'updated 2007/01/20
'2006/11/15, 2006/11/14, 2006/11/12, 2006/11/11, 2006/10/25
'primes 9quad greater than 9E15 as total of two numbers
vari d_any, s_any, d_dot, s_dot, s_out
vari d_9part, d_factor, d_seconds, s_input
vari d_process, d_9quad, d_9mult, s_default
dpow d_any, 10, 15
d_9quad = d_any * 9
d_process = 1
dift d_process = 1
$out "1. 9,002,235,408,655,631"
$out "2. 999,999,999,999,999,989"
$out "3. 108,000,000,000,000,001"
$inp s_input, "choose or enter number to test"
$ift s_input = "*": dinc d_process
$ift s_input = "1": s_input = "9,002,235,408,655,631"
$ift s_input = "2": s_input = "999,999,999,999,999,989"
$ift s_input = "3": s_input = "108,000,000,000,000,001"
endi
dift d_process = 1
$out s_input
sg_pass1 = s_input
sub_9quad_from_string
d_9part = dg_pass1
d_9mult = dg_pass2
endi
dift d_process = 1
dsec d_seconds
dfak d_factor, d_9part, d_9mult
dsec d_any
d_seconds = d_any - d_seconds
$out "seconds=" + d_seconds
ded$ s_any, d_9part, 0, 0
$out "d_9part=" + s_any
ded$ s_any, d_9mult, 0, 0
$out "d_9mult=" + s_any
ded$ s_any, d_factor, 0, 0
$out "d_factor=" + s_any
endi
$inp s_any, "done"
ends sub_9quad_primes_test_one_number
subr sub_9quad_primes_find
'updated 2007/01/19
'2006/11/27, 2006/11/25, 2006/11/13, 2006/11/12, 2006/11/11
'2006/10/29, 2006/10/28, 2006/10/27, 2006/10/26, 2006/10/25
'find primes 9quad than 2^53 as total of two numbers
vari d_any, s_any, d_dot, s_dot, s_out
vari s_number, d_9part, d_9mult, d_count, d_ctmax
vari d_process, d_loop, d_show, d_factor, s_factor
vari d_seconds, d_previous, d_gap
d_process = 1
dift d_process = 1
d_9part = 1
d_9mult = 1
$inp s_number, "enter begin number, default=9quad"
$ift s_number = "*": dinc d_process
endi
dift d_process = 1
sg_pass1 = s_number
sub_9quad_from_string
d_9part = dg_pass1
d_9mult = dg_pass2
d_any = d_9part % 2
dift d_any = 0: dinc d_9part
ded$ s_any, d_9part, 0, 0
$out "9part=" + s_any
$out "9mult=" + d_9mult
endi
dift d_process = 1
d_show = 2
$inp s_any, "1=show tries"
$ift s_any = "*": dinc d_process
$ift s_any = "1": d_show = 1
endi
dift d_process = 1
d_ctmax = 100
$inp s_any, "how many to find, default=100"
$ift s_any = "*": dinc d_process
$isd d_any, s_any
dift d_any = 1: $tod d_ctmax, s_any
endi
d_count = 0
d_loop = d_process
dwhi d_loop = 1
dsec d_seconds
'use teapro command for fast method
dfak d_factor, d_9part, d_9mult
dsec d_any
d_seconds = d_any - d_seconds
dift d_show = 1
'show number just tested
dg_pass1 = d_9part
dg_pass2 = d_9mult
sub_9quad_to_string
s_number = sg_pass1
ded$ s_factor, d_factor, 0, 0
s_out = s_number + ", factor=" + s_factor
$app s_out, ", sec=" + d_seconds
$out s_out
endi
dift d_factor = 1
'we have a 9quad prime
dinc d_count
'find gap to previous prime
d_gap = 0
dift d_previous > 0: d_gap = d_9part - d_previous
d_previous = d_9part
dg_pass1 = d_9part
dg_pass2 = d_9mult
sub_9quad_to_string
s_number = sg_pass1
s_out = d_count + ". prime=" + s_number
$app s_out, ", sec=" + d_seconds
$app s_out, ", gap=" + d_gap
$out s_out
endi
d_9part = d_9part + 2
dift d_count >= d_ctmax: dinc d_loop
endw
$inp s_any, "done"
ends sub_9quad_primes_find
subr sub_teaquad_primes_find
'updated 2007/02/24, 2007/01/07, 2007/01/06
'2006/12/11, 2006/12/09, 2006/12/08, 2006/12/07, 2006/12/06
'2006/11/27, 2006/11/25, 2006/11/13, 2006/11/12, 2006/11/11
'2006/10/29, 2006/10/28, 2006/10/27, 2006/10/26, 2006/10/25
'find primes teaquad greater than 1E15 as total of two numbers
vari d_any, s_any, d_dot, s_dot, s_out
vari s_number, d_teaquadpart, d_teaquadmult, d_count, s_count
vari d_process, d_loop, d_show, d_factor, s_factor
vari d_seconds, d_previous, d_gap, d_ctmax
vari d_teaquadnum, d_maxteaquadpart, d_maxteaquadmult
vari d_stopteaquadpart, d_stopteaquadmult
vari d_file, s_filename, s_date, d_factfactor
'stop for sure at 1E21
dpow d_maxteaquadpart, 10, 15
$tod d_maxteaquadmult, "999,999"
d_teaquadnum = d_maxteaquadpart
d_process = 1
dift d_process = 1
d_teaquadpart = 1
d_teaquadmult = 1
$inp s_number, "enter begin number, default=teaquad"
$ift s_number = "*": dinc d_process
endi
dift d_process = 1
$trb s_number, s_number
$ift s_number <> sg_nothing
sg_pass1 = s_number
sub_teaquad_from_string
d_teaquadpart = dg_pass1
d_teaquadmult = dg_pass2
endi
d_any = d_teaquadpart % 2
dift d_any = 0: dinc d_teaquadpart
ded$ s_any, d_teaquadpart, 0, 0
$out "1part=" + s_any
$out "1mult=" + d_teaquadmult
endi
dift d_process = 1
d_show = 2
$inp s_any, "1=show tries"
$ift s_any = "*": dinc d_process
$ift s_any = "1": d_show = 1
endi
dift d_process = 1
d_ctmax = 99999
$inp s_any, "how many to find, default=99999"
$ift s_any = "*": dinc d_process
$isd d_any, s_any
dift d_any = 1: $tod d_ctmax, s_any
endi
dift d_process = 1
d_file = 2
s_filename = "primes99.txt"
$inp s_any, "1=output to file " + s_filename
$ift s_any = "*": dinc d_process
$ift s_any = "1"
d_file = 1
flen d_any, s_filename
dift d_any >= 0
$inp s_any, "1=purge old file"
$ift s_any = "*": dinc d_process
$ift s_any = "1": fdel d_any, s_filename
endi
endi
endi
dift d_process = 1
d_stopteaquadpart = d_maxteaquadpart
d_stopteaquadmult = d_maxteaquadmult
$inp s_any, "enter stop number if wanted"
$ift s_any = "*": dinc d_process
sg_pass1 = s_any
sub_teaquad_from_string
d_stopteaquadpart = dg_pass1
d_stopteaquadmult = dg_pass2
s_out = "stop: 1part=" + d_stopteaquadpart
$app s_out, ", 1mult=" + d_stopteaquadmult
$out s_out
endi
d_count = 0
d_loop = d_process
dwhi d_loop = 1
dsec d_seconds
'use teapro command for fast method
dfak d_factor, d_teaquadpart, d_teaquadmult
dsec d_any
d_seconds = d_any - d_seconds
$dat s_date
$cut s_date, s_date, 1, 20
'is the factor prime
dfac d_factfactor, d_factor
'show number just tested
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
sub_teaquad_to_string
s_number = sg_pass1
ded$ s_factor, d_factor, 0, 0
'if factor is prime append ":P"
dift d_factfactor = 1: $app s_factor, ":P"
s_out = s_number + " " + s_date
$app s_out, " fact=" + s_factor
$app s_out, " sec=" + d_seconds
$sho s_out
dift d_show = 1
$out s_out
dift d_file = 1: fapp d_any, "primes99.txt", s_out
endi
dift d_factfactor <> 1
$out s_out
$inp s_any, "factor not prime"
$ift s_any = "*": dinc d_loop
endi
dift d_factor = 1
'we have a teaquad prime
dinc d_count
s_count = "0000" + d_count
$off s_count, s_count, 4
'find gap to previous prime
d_gap = 0
dift d_previous > 0: d_gap = d_teaquadpart - d_previous
d_previous = d_teaquadpart
dg_pass1 = d_teaquadpart
dg_pass2 = d_teaquadmult
sub_teaquad_to_string
s_number = sg_pass1
s_out = s_count + ".prime=" + s_number
$app s_out, " " + s_date
$app s_out, " sec=" + d_seconds
$app s_out, " gap=" + d_gap
$out s_out
dift d_file = 1
s_out = "]" + " " + s_count
$app s_out, ".prime=" + s_number
$app s_out, " " + s_date
$app s_out, " gap=" + d_gap
fapp d_any, "primes99.txt", s_out
dbad d_any = 0
endi
endi
d_teaquadpart = d_teaquadpart + 2
dift d_teaquadpart > d_teaquadnum
dinc d_teaquadmult
d_teaquadpart = 1
endi
dift d_count >= d_ctmax: dinc d_loop
dift d_stopteaquadpart > 0
dift d_teaquadmult >= d_stopteaquadmult
dift d_teaquadpart >= d_stopteaquadpart: dinc d_loop
endi
endi
'cannot go over 1E21
dift d_teaquadmult >= d_maxteaquadmult
dift d_teaquadpart >= d_maxteaquadpart: dinc d_loop
endi
endw
$inp s_any, "done"
ends sub_teaquad_primes_find
subr sub_teaquad_to_string
'updated 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
'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_9quad_to_string
'updated 2006/11/25, 2006/11/12, 2006/10/27
'change a 9quad number to a string
vari d_any, s_any, d_dot, s_dot
vari d_9part, d_9mult, s_line
vari s_beg, d_beg
d_9part = dg_pass1
d_9mult = dg_pass2
'123456789012345678901234567
'123,456,789,012,345,678,901
'123456789012345678901
dto$ s_line, d_9part, 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_9mult * 9 + 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
$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_9quad_to_string
subr sub_9quad_from_string
'updated 2006/11/25, 2006/11/12, 2006/10/28
'9quad string to d_9part
vari d_any, s_any, d_dot, s_dot
vari d_9part, d_9mult
vari s_line, d_good, d_long, s_beg, d_beg
s_line = sg_pass1
d_9part = 0
d_9mult = 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
dift d_good = 1
$len d_long, s_line
dift d_long < 16
$tod d_9part, s_line
dinc d_good
endi
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_beg, s_beg
d_9mult = d_beg \ 9
d_beg = d_beg % 9
$cut s_any, s_line, 7, 99
s_any = d_beg + s_any
$tod d_9part, s_any
endi
dg_pass1 = d_9part
dg_pass2 = d_9mult
ends sub_9quad_from_string
subr sub_quad_primes
'updated 2005/08/01, 2005/07/31, 2005/07/23, 2005/07/22, 2005/06/11
'2005/06/07, 2005/06/05, 2005/05/31, 2005/05/17, 2005/05/16
'2005/05/14, 2005/05/11, 2005/05/06, 2005/05/02, 2005/04/29
'2005/04/27, 2005/04/24, 2005/04/23, 2005/04/04, 2005/04/02
'2005/03/31, 2005/03/21, 2005/03/14, 2005/03/10, 2005/03/09
'2005/03/08, 2005/03/03, 2005/03/02, 2005/02/27, 2005/02/24
'find quad primes by modulus
'dg_pass=1=d_which means must enter beginning
'dg_pass=2=d_which means begin again from number in file
vari d_any, s_any, d_dot, s_dot, s_out
vari d_good, s_date, s_timehournew, s_timehourold
vari d_primetest, s_primetest, d_maxprimetest, d_begin
vari d_hourprimetest, s_billperhour, s_trillperday
vari d_billperhour, d_trillperday
vari d_pivcom, s_pivcom, d_modulus, d_prevquad
vari d_number, d_index, d_maxindex, d_divisor
vari d_filebyte, d_loop, s_record, s_file5tp39
vari s_tfile, s_pfile, d_long, d_which
vari d_11mod, d_13mod
$sys s_any, 2
$out s_any
'put d_maxindex primes in array
d_maxindex = 2000
d_number = 7
d_index = 1
dwhi d_index <= d_maxindex
d_modulus = 9999
dwhi d_modulus > 1
dfac d_modulus, d_number
dift d_modulus > 1: d_number = d_number + 2
endw
dtoi d_index, d_number
d_number = d_number + 2
dinc d_index
endw
$inp s_any, "1=begin at previous ending"
d_which = 1
$ift s_any = "1": d_which = 2
'd_which=1 for enter beginning number
'd_which=2 for begin again get number from file
s_tfile = "tquad1.txt"
s_pfile = "pquad1.txt"
dift d_which = 1
'enter beginning number
$out "beginning number"
$inp s_any, "123456789012345678901"
d_begin = 99999
$isd d_any, s_any
dift d_any = 1: $tod d_begin, s_any
endi
dift d_which = 2
'get beginning number from file
d_begin = 0
d_filebyte = 1
d_loop = 1
dwhi d_loop = 1
fsip s_record, s_tfile, d_filebyte
dift d_filebyte = 0
dinc d_loop
else
$out s_record
$lok d_any, s_record, 1, " "
$cut s_any, s_record, 1, d_any
$trb s_any, s_any
$isd d_any, s_any
dift d_any = 1: $tod d_begin, s_any
endi
endw
endi
ded$ s_any, d_begin, 0, 0
$out "begin=" + s_any
'quads have to be 30 apart and end with 1
'make sure d_begin % 30 is 11
d_begin = d_begin \ 30 * 30 + 11
ded$ s_any, d_begin, 0, 0
$out "begin=" + s_any
d_primetest = d_begin
d_prevquad = 0
d_hourprimetest = d_primetest
'loop endlessly
dwhi 1 = 1
d_index = 1
d_maxprimetest = d_primetest + 8
dwhi d_index <= d_maxindex
itod d_divisor, d_index
d_modulus = d_maxprimetest % d_divisor
dift d_modulus = 0
d_index = 9999
else
dift d_modulus = 2
d_index = 9999
else
dift d_modulus = 6
d_index = 9999
else
dift d_modulus = 8
d_index = 9999
endi
endi
endi
endi
dinc d_index
endw
'$out "last d_divisor=" + d_divisor
'ded$ s_any, d_primetest, 0, 0
'$inp s_any, s_any
d_good = 2
dift d_index < 9999: dfac d_good, d_primetest
dift d_good = 1
'd_primetest is prime
'12345678901234567890123456789012345
'17-DEC-2002 03:56:22 20021217035622
$dat s_date
$cut s_date, s_date, 1, 20
ded$ s_primetest, d_primetest, 0, 0
s_out = s_primetest + " " + s_date
'get the hour for below
$cut s_timehournew, s_date, 13, 2
$ift s_timehournew = s_timehourold
$sho s_out
else
'get perhr change
d_dot = d_primetest - d_hourprimetest
d_hourprimetest = d_primetest
d_billperhour = d_dot / 1000
d_trillperday = d_dot * 24 / 1000 / 1000
dto$ s_billperhour, d_billperhour, 5, 1
$trb s_billperhour, s_billperhour
s_billperhour = " tph=" + s_billperhour
$app s_out, s_billperhour
dto$ s_trillperday, d_trillperday, 5, 3
$trb s_trillperday, s_trillperday
$app s_out, " mpd=" + s_trillperday
s_timehourold = s_timehournew
fapp d_any, s_tfile, s_out
dbad d_any = 0
$out s_out
endi
'is d_primetest + 2 a prime
d_any = d_primetest + 2
dfac d_good, d_any
dift d_good = 1
'is d_primetest + 6 a prime
d_any = d_primetest + 6
dfac d_good, d_any
dift d_good = 1
'is d_primetest + 8 a prime
d_any = d_primetest + 8
dfac d_good, d_any
dift d_good = 1
'we have a quad prime
ded$ s_primetest, d_primetest, 0, 0
'show the just found quad
$dat s_date
$cut s_date, s_date, 1, 20
d_dot = 0
dift d_prevquad > 0: d_dot = d_primetest - d_prevquad
d_prevquad = d_primetest
s_out = "] 000:QUAD= " + s_primetest
$app s_out, " " + s_date + " " + d_dot
$out s_out
fapp d_any, s_tfile, s_out
dbad d_any = 0
fapp d_any, s_pfile, s_out
dbad d_any = 0
fapp d_any, s_tfile, s_primetest
dbad d_any = 0
endi
endi
endi
endi
'quads have to be 30 apart and end with 1
d_primetest = d_primetest + 30
endw
ends sub_quad_primes
subr sub_5tp39_two_files_compare
'updated 2007/11/18, 2005/10/15, 2004/05/11
vari d_any, s_any, d_dot, s_dot, s_out
vari s_filename1, s_filedata1, s_filename2, s_filedata2
vari d_process, d_loop, d_big, d_ctlines
vari d_ctfound, d_ctnotfound
vari s_5tp39, s_lookstring
vari d_ctdata1, d_ctdata2
$out "5tp39s in file1 are looked up in file2"
$inp s_filename1, "enter filename1"
$inp s_filename2, "enter filename2"
finp s_filedata1, s_filename1
finp s_filedata2, s_filename2
$cup s_filedata1, s_filedata1
$cup s_filedata2, s_filedata2
s_lookstring = "5TP39="
$cnt d_ctdata1, s_filedata1, s_lookstring
$cnt d_ctdata2, s_filedata2, s_lookstring
d_process = 1
$len d_any, s_filedata1
s_out = s_filename1 + ", length=" + d_any
$app s_out, ", count=" + d_ctdata1
$out s_out
dift d_any = 0: dinc d_process
$len d_any, s_filedata2
s_out = s_filename2 + ", length=" + d_any
$app s_out, ", count=" + d_ctdata2
$out s_out
dift d_any = 0: dinc d_process
d_ctdata1 = 0
d_ctfound = 0
d_ctnotfound = 0
d_ctlines = 0
dpow d_big, 10, 10
$out "from " + s_filename1 + " looking in " + s_filename2
d_loop = d_process
dwhi d_loop = 1
$lok d_dot, s_filedata1, 1, s_lookstring
dift d_dot = 0
'no more are in s_filedata1
dinc d_loop
else
'we found a s_lookstring in s_data1
'tell
dinc d_ctdata1
d_any = d_ctdata1 % 10
dift d_any = 0: $sho d_ctdata1
'5TP39=^
'0123456
d_dot = d_dot + 6
$cut s_filedata1, s_filedata1, d_dot, d_big
$trb s_filedata1, s_filedata1
$lok d_dot, s_filedata1, 1, " "
$cut s_5tp39, s_filedata1, 1, d_dot
$trb s_5tp39, s_5tp39
s_5tp39 = "5TP39= " + s_5tp39 + " "
'is it in s_filedata2
$lok d_dot, s_filedata2, 1, s_5tp39
dift d_dot > 0
'in both
dinc d_ctfound
else
'not found in s_data2
dinc d_ctnotfound
s_out = d_ctnotfound
$app s_out, ". " + s_5tp39
$app s_out, " only in " + s_filename1
$app s_out, " but not in " + s_filename2
$out s_out
dinc d_ctlines
dift d_ctlines >= 20
d_ctlines = 0
$inp s_any, "more"
$ift s_any = "*": dinc d_loop
endi
endi
endi
endw
$out "found=" + d_ctfound + ", not=" + d_ctnotfound
$inp s_any, "done"
ends sub_5tp39_two_files_compare
subr sub_5tp39_validate_in_file
'updated 2006/09/23, 2005/06/09
'2005/05/19, 2005/05/02, 2005/05/01, 2005/04/29, 2005/04/20
'2005/04/19, 2005/04/08, 2005/03/31, 2005/03/07, 2005/03/06
vari d_any, s_any, d_dot, s_dot, s_tap, s_out
vari d_filebyte, s_record, s_filename, d_loop, d_good
vari s_number, d_number, d_seconds, d_begin, d_count
vari d_yestest, d_process
vari d_3cluster, d_1hold, d_2hold, d_diff
vari d_pivcom, s_factors
vari d_largegap, d_smallgap
$sys s_any, 2
$out s_any
d_process = 1
dift d_process = 1
$inp s_any, "1=do not test for 5TP39, default=do test"
$ift s_any = "*": dinc d_process
d_yestest = 1
$ift s_any = "1": dinc d_yestest
endi
dift d_process = 1
$inp s_any, "enter number to begin, default = 1.7*10^15"
$ift s_any = "*": dinc d_process
$tod d_begin, "1,700,000,000,000,000"
$isd d_any, s_any
dift d_any = 1: $tod d_begin, s_any
endi
dift d_process = 1
$inp s_any, "enter amount for a 3cluster, default=0=no"
$ift s_any = "*": dinc d_process
d_3cluster = 0
$isd d_any, s_any
dift d_any = 1: $tod d_3cluster, s_any
endi
dift d_process = 1
d_largegap = 0
$inp s_any, "1 = large gap of 7*10^12 or enter other"
$ift s_any = "*": dinc d_process
$ift s_any = "1": s_any = "7,000,000,000,000"
$isd d_any, s_any
dift d_any = 1: $tod d_largegap, s_any
endi
dift d_process = 1
d_smallgap = 0
$inp s_any, "1 = small gap of 5*10^9 or enter other"
$ift s_any = "*": dinc d_process
$ift s_any = "1": s_any = "5,000,000,000"
$isd d_any, s_any
dift d_any = 1: $tod d_smallgap, s_any
endi
$out "3cluster=" + d_3cluster
s_filename = "fix5tp39.exp"
$out "input file=" + s_filename
d_count = 0
d_filebyte = 1
d_loop = d_process
dwhi d_loop = 1
d_good = 1
fsip s_record, s_filename, d_filebyte
dift d_filebyte = 0
dinc d_good
dinc d_loop
endi
dift d_good = 1
$cut s_any, s_record, 1, 5
$ift s_any = "]STOP"
dinc d_good
dinc d_loop
endi
endi
dift d_good = 1
$lok d_dot, s_record, 1, "5TP39="
dift d_dot = 0: dinc d_good
endi
dift d_good = 1
'5TP39= 39,713...
d_dot = d_dot + 7
$lok d_any, s_record, d_dot, " "
d_any = d_any - d_dot + 1
$cut s_number, s_record, d_dot, d_any
$trb s_number, s_number
$isd d_any, s_number
dift d_any <> 1
$inp s_any, s_number
dinc d_good
endi
endi
dift d_good = 1
$tod d_number, s_number
dift d_number < d_begin: dinc d_good
endi
dift d_good = 1
dift d_yestest = 1
dsec d_seconds
dg_pass1 = d_number
sub_5tp39_parm_test_new
d_dot = dg_pass1
dsec d_any
d_seconds = d_any - d_seconds
else
d_dot = 1
endi
dift d_dot <> 1
'do not have 5TP39
$inp s_any, "not 5TP39= " + s_number
else
'have 5TP39
dinc d_count
d_pivcom = d_number + 19 / 210
d_any = d_pivcom % 11
s_factors = d_any
d_any = d_pivcom % 13
$app s_factors, "," + d_any
d_any = d_pivcom % 17
$app s_factors, "," + d_any
d_any = d_pivcom % 19
$app s_factors, "," + d_any
s_out = d_count + ". 5TP39= " + s_number
$app s_out, " secs= " + d_seconds
$app s_out, ", diff=" + s_factors
$out s_out
'small gap
dift d_smallgap > 0
d_diff = d_number - d_1hold
dift d_diff < d_smallgap
ded$ s_any, d_number,0 ,0
ded$ s_dot, d_1hold, 0, 0
ded$ s_tap, d_diff, 0, 0
s_out = "small gap: " + s_any
$app s_out, ", " + s_dot
$app s_out, " of " + s_tap
$inp s_any, s_out
endi
endi
'large gap
dift d_largegap > 0
d_diff = d_number - d_1hold
dift d_diff > d_largegap
ded$ s_any, d_number,0 ,0
ded$ s_dot, d_1hold, 0, 0
ded$ s_tap, d_diff, 0, 0
s_out = "large gap: " + s_any
$app s_out, ", " + s_dot
$app s_out, " of " + s_tap
$inp s_any, s_out
endi
endi
'3cluster
dift d_3cluster > 0
d_diff = d_number - d_2hold
dift d_diff < d_3cluster
ded$ s_any, d_2hold, 0, 0
$out "3cluster=" + s_any
ded$ s_any, d_1hold, 0, 0
$out "3cluster=" + s_any
ded$ s_any, d_number, 0, 0
$out "3cluster=" + s_any
ded$ s_any, d_diff, 0, 0
$out "difference=" + s_any
$inp s_any, "3cluster, * to end"
$ift s_any = "*": dinc d_loop
endi
endi
d_2hold = d_1hold
d_1hold = d_number
endi
endi
endw
$inp s_any, "count=" + d_count
ends sub_5tp39_validate_in_file
subr sub_5tp39_factors
'updated 2005/05/02
'factors of dg_pass1 into sg_pass1
vari d_any, s_any, d_dot, s_dot
vari d_number, d_factor, s_result
vari d_good, d_loop
d_number = dg_pass1 / 210
s_result = sg_nothing
d_loop = 1
dwhi d_loop = 1
dfac d_factor, d_number
$app s_result, "," + d_factor
dift d_factor > 1
d_number = d_number / d_factor
else
dinc d_loop
endi
endw
sg_pass1 = s_result
ends sub_5tp39_pivcom_factors
subr sub_5tp39_parm_test_old
'updated 2005/03/06
vari d_any, s_any, d_dot, s_dot
vari d_number, d_factor
'11,13,17,19,29,31,41,43,47,49
d_number = dg_pass1
dfac d_factor, d_number
d_any = d_number + 2
dift d_factor = 1: dfac d_factor, d_any
d_any = d_number + 6
dift d_factor = 1: dfac d_factor, d_any
d_any = d_number + 8
dift d_factor = 1: dfac d_factor, d_any
d_any = d_number + 18
dift d_factor = 1: dfac d_factor, d_any
d_any = d_number + 20
dift d_factor = 1: dfac d_factor, d_any
d_any = d_number + 30
dift d_factor = 1: dfac d_factor, d_any
d_any = d_number + 32
dift d_factor = 1: dfac d_factor, d_any
d_any = d_number + 36
dift d_factor = 1: dfac d_factor, d_any
d_any = d_number + 38
dift d_factor = 1: dfac d_factor, d_any
dg_pass1 = d_factor
ends sub_5tp39_parm_test_old
subr sub_5tp39_parm_test_new
'updated 2006/09/23, 2005/03/06
vari d_any, s_any, d_dot, s_dot
vari d_number, d_factor
'11,13,17,19,29,31,41,43,47,49
d_number = dg_pass1
dfac d_factor, d_number
dift d_factor = 1
d_any = d_number + 2
dfac d_factor, d_any
dift d_factor = 1
d_any = d_number + 6
dfac d_factor, d_any
dift d_factor = 1
d_any = d_number + 8
dfac d_factor, d_any
dift d_factor = 1
d_any = d_number + 18
dfac d_factor, d_any
dift d_factor = 1
d_any = d_number + 20
dfac d_factor, d_any
dift d_factor = 1
d_any = d_number + 30
dfac d_factor, d_any
dift d_factor = 1
d_any = d_number + 32
dfac d_factor, d_any
dift d_factor = 1
d_any = d_number + 36
dfac d_factor, d_any
dift d_factor = 1
d_any = d_number + 38
dfac d_factor, d_any
endi
endi
endi
endi
endi
endi
endi
endi
endi
dg_pass1 = d_factor
ends sub_5tp39_parm_test_new
subr sub_teaquad_5tp39_test_a_number
'updated 2007/09/06
'2007/02/25, 2006/07/29, 2005/07/23, 2005/05/01, 2005/04/17
'2005/04/14, 2005/03/31, 2005/03/27, 2005/03/18, 2005/03/16
vari d_any, s_any, d_dot, s_dot, s_out
vari d_process, d_loop, d_factor, s_dashes, d_yes, d_count
vari s_number, d_number, d_trynum, s_trynum
vari d_seconds1, d_seconds2, d_seconds3
vari d_teaquadpart, d_teaquadmult
vari d_tryteaquadpart, d_tryteaquadmult
$sys s_any, 2
$out s_any
$ch$ s_dashes, "-", 70
d_process = 1
d_loop = d_process
dwhi d_loop = 1
$out s_dashes
$out "1. 5TP39= 39,713,433,671"
$out "2. 5TP39= 1,943,372,747,435,261"
$out "3. 5TP39= 1,943,381,207,047,331"
$out "25. 5TP39= 13,069,672,451,845,151"
$out "99. 5TP39= 99,996,530,453,619,851"
$inp s_number, "enter the first number of a 5TP39"
$ift s_number = "*"
dinc d_loop
dinc d_process
endi
$ift s_number = "1": s_number = "39,713,433,671"
$ift s_number = "2": s_number = "1,943,372,747,435,261"
$ift s_number = "3": s_number = "1,943,381,207,047,331"
$ift s_number = "25": s_number = "13,069,672,451,845,151"
$ift s_number = "99": s_number = "99,996,530,453,619,851"
dift d_process = 1
$out s_number
sg_pass1 = s_number
sub_teaquad_from_string
d_teaquadpart = dg_pass1
d_teaquadmult = dg_pass2
ded$ s_any, d_teaquadpart, 0, 0
$out "d_teaquadpart=" + s_any
ded$ s_any, d_teaquadmult, 0, 0
$out "d_teaquadmult=" + s_any
endi
dift d_process = 1
d_count = 0
d_yes = 1
dsec d_seconds1
'11
dinc d_count
d_tryteaquadpart = d_teaquadpart
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
'13
dinc d_count
d_tryteaquadpart = d_teaquadpart + 2
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
'17
dinc d_count
d_tryteaquadpart = d_teaquadpart + 6
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
'19
dinc d_count
d_tryteaquadpart = d_teaquadpart + 8
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
'29
dinc d_count
d_tryteaquadpart = d_teaquadpart + 18
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
'31
dinc d_count
d_tryteaquadpart = d_teaquadpart + 20
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
'41
dinc d_count
d_tryteaquadpart = d_teaquadpart + 30
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
'43
dinc d_count
d_tryteaquadpart = d_teaquadpart + 32
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
'47
dinc d_count
d_tryteaquadpart = d_teaquadpart + 36
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
'49
dinc d_count
d_tryteaquadpart = d_teaquadpart + 38
d_tryteaquadmult = d_teaquadmult
dg_pass1 = d_tryteaquadpart
dg_pass2 = d_tryteaquadmult
sub_teaquad_to_string
s_trynum = d_count + "=" + " " + sg_pass1
dsec d_seconds2
dfak d_factor, d_tryteaquadpart, d_tryteaquadmult
dsec d_seconds3
dift d_factor = 1
s_out = s_trynum + " is prime"
else
s_out = s_trynum + " is not prime, " + d_factor
dinc d_yes
endi
d_seconds3 = d_seconds3 - d_seconds2
$out s_out + " sec=" + d_seconds3
dsec d_any
d_seconds1 = d_any - d_seconds1
$out s_dashes
dift d_yes = 1
s_any = "yes, 5TP39, number=" + s_number
$app s_any, ", seconds=" + d_seconds1
$out s_any
else
s_any = "not 5TP39, number=" + s_number
$app s_any, ", seconds=" + d_seconds1
$out s_any
endi
$inp s_any, "return"
$ift s_any = "*": dinc d_loop
endi
endw
ends sub_teaquad_5tp39_test_a_number
subr sub_5tp39_entry_test
'updated 2007/11/18, 2006/09/24
'2006/09/23, 2006/07/29, 2005/07/23, 2005/05/01, 2005/04/17
'2005/04/14, 2005/03/31, 2005/03/27, 2005/03/18, 2005/03/16
vari d_any, s_any, d_dot, s_dot
vari s_pick, d_pick
vari d_loop, d_good, d_fast, d_yes, d_test, s_dashes
vari s_number, d_number, d_try, s_try, d_seconds
vari d_totlines, d_process, d_extratesting
$sys s_any, 2
$out s_any
d_process = 1
dift d_process = 1
$inp s_any, "1=fast method"
$ift s_any = "*": dinc d_process
d_fast = 2
$ift s_any = "1": d_fast = 1
s_any = "-"
$ch$ s_dashes, s_any, 70
endi
dift d_process = 1
d_extratesting = 2
$inp s_any, "1=extra testing of subs"
$ift s_any = "*": dinc d_process
$ift s_any = "1": d_extratesting = 1
endi
d_loop = d_process
dwhi d_loop = 1
d_good = 1
s_number = "X"
d_pick = 0
$out s_dashes
$out "2. 5TP39=11"
$out "3. 5TP39= 39,713,433,671"
$out "5. 5TP39= 165,881,934,823,901"
$out "12. 5TP39= 1,943,372,747,435,261"
$out "13. 5TP39= 1,943,381,207,047,331"
$out "52. 5TP39= 5,252,720,343,174,971"
$out "72. 5TP39= 8,568,071,300,147,501"
$out "75. 5TP39= 8,999,280,480,245,351"
$out "76. 5TP39= 9,002,235,408,655,631"
$inp s_pick, "enter the first number of a 5TP39"
$ift s_pick = "*": dinc d_good
$isd d_any, s_pick
dift d_any = 1
$tod d_pick, s_pick
s_number = s_pick
endi
dift d_pick = 2: s_number = 11
dift d_pick = 3: s_number = "39,713,433,671"
dift d_pick = 5: s_number = "165,881,934,823,901"
dift d_pick = 12: s_number = "1,943,372,747,435,261"
dift d_pick = 13: s_number = "1,943,381,207,047,331"
dift d_pick = 52: s_number = "5,252,720,343,174,971"
dift d_pick = 72: s_number = "8,568,071,300,147,501"
dift d_pick = 75: s_number = "8,999,280,480,245,351"
dift d_pick = 76: s_number = "9,002,235,408,655,631"
dift d_good = 1
$isd d_any, s_number
d_good = d_any
endi
dift d_good <> 1: dinc d_loop
dift d_good = 1
$tod d_number, s_number
ded$ s_number, d_number, 0, 0
d_yes = 1
dift d_extratesting = 1
'old
dsec d_seconds
dg_pass1 = d_number
sub_5tp39_parm_test_old
dsec d_any
d_seconds = d_any - d_seconds
$out "old sec=" + d_seconds + ", fac=" + dg_pass1
'new
dsec d_seconds
dg_pass1 = d_number
dbug
sub_5tp39_parm_test_new
dbug
dsec d_any
d_seconds = d_any - d_seconds
d_totlines = d_any - d_totlines
$out "lines=" + d_totlines
$out "new sec=" + d_seconds + ", fac=" + dg_pass1
endi
dsec d_seconds
'11
d_try = d_number
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
'13
d_try = d_number + 2
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
'17
d_try = d_number + 6
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
'19
d_try = d_number + 8
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
'29
d_try = d_number + 18
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
'31
d_try = d_number + 20
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
'41
d_try = d_number + 30
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
'43
d_try = d_number + 32
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
'47
d_try = d_number + 36
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
'49
d_try = d_number + 38
ded$ s_try, d_try, 0, 0
dift d_fast = 1
'fast method
dfac d_test, d_try
else
'slow method
dg_pass1 = d_try
sub_prime_test_simple
d_test = dg_pass1
endi
dift d_test = 1
$out s_try + " is prime"
else
$out s_try + " is not prime, " + d_test
dinc d_yes
endi
dsec d_any
d_seconds = d_any - d_seconds
$out s_dashes
dift d_yes = 1
s_any = "yes, 5TP39, number=" + s_number
$app s_any, ", seconds=" + d_seconds
$out s_any
else
s_any = "not 5TP39, number=" + s_number
$app s_any, ", seconds=" + d_seconds
$out s_any
endi
$inp s_any, "return"
endi
endw
ends sub_5tp39_entry_test
subr sub_test_beyond_limits
'updated 2007/10/16, 2007/10/15
vari d_any, s_any, d_dot, s_dot
vari d_process
d_process = 1
dift d_process = 1
'test the bad index
d_any = 12345
d_dot = 8001
$inp s_any, "1=dtoi d_any,d_dot"
$ift s_any = "*": dinc d_process
$ift s_any = "1": dtoi d_any, d_dot
endi
dift d_process = 1
'test the bad index
d_any = 12345
d_dot = 8001
$inp s_any, "1=itod d_dot,d_any"
$ift s_any = "*": dinc d_process
$ift s_any = "1": itod d_dot, d_any
endi
$inp s_any, "done"
ends sub_test_beyond_limits
subr sub_command_test
'updated 2007/02/24, 2005/11/01, 2005/09/20, 2005/08/23, 2005/08/17
'2005/07/26, 2005/07/25, 2005/07/17, 2005/05/03, 2005/04/24
'2005/04/20, 2005/04/12, 2005/04/06, 2005/04/04, 2005/03/31
'2005/03/19, 2005/03/12, 2005/03/07, 2005/03/05, 2005/03/02
'2005/02/20, 2005/02/17, 2005/02/12, 2005/02/10, 2004/12/09
'command test
vari d_any, s_any, d_dot, s_dot, s_tap, s_out
vari d_loop, s_pick, d_pick, d_long
vari d_show, d_count, d_part, d_seconds
vari s_number1, s_number2
vari d_number1, d_number2, d_answer
vari s_string1, s_string2
vari d_wide, d_decimals, d_index, s_index
vari s_filename, s_record, d_byte, s_filedata
$sys s_any, 2
$out s_any
'd_loop is for looping
d_loop = 1
dwhi d_loop = 1
d_pick = 0
$out "1. test command $CUT,$LEN,$TRL,$TRR,$TRB"
$out "2. test command $IFT,ELSE,ENDI"
$out "3. test command DTO$,DED$,$LEN,DPK$,DTOF"
$out "4. test command $TOD,DTO$,$ISD,$PKD"
$out "5. test command FWRI,FREA,FLEN"
$out "6. test command $INS,$REP"
$out "7. test command $DEL"
$out "8. test command $DAT"
$out "9. test command FSIP,FINP,FOUT"
$out "10. test command $LOK,$BAK"
$out "11. test command $ISC"
$out "12. test command $PAR"
$out "13. test command $SOR"
$out "14. test command $OUT,$SHO"
$out "15. test commands FINP,$CNT"
$out "16. test commands $TOI,ITO$,DTOI,ITOD"
$out "17. test commands DFAC,DFAK"
$inp s_pick, "pick a number, * to end"
d_pick = 0
$isd d_any, s_pick
dift d_any = 1: $tod d_pick, s_pick
'an asterisk is char 42
$ift s_pick = "*": d_loop = 2
dift d_pick=1
'test $CUT,$len,$trb,$trl,$trr
dran d_any
dran d_dot
$out "randoms=" + d_any + ", " + d_dot
s_string1 = "123456789012345678901234567890"
$out s_string1
$inp s_any, "enter begin number"
d_number1 = 1
$isd d_any, s_any
dift d_any = 1: $tod d_number1, s_any
$inp s_any, "enter length number"
d_number2 = 1
$isd d_any, s_any
dift d_any = 1: $tod d_number2, s_any
$cut s_string2 ,s_string1, d_number1, d_number2
$out s_string2
$len d_long, s_string2
$out "length=" + d_long
s_string2 = " " + s_string1 + " "
$out "'" + s_string2 + "'"
$trl s_any, s_string2
$out "$trl='" + s_any + "'"
$trr s_any, s_string2
$out "$trr='" + s_any + "'"
$trb s_any, s_string2
$out "$trb='" + s_any + "'"
$inp s_any, "return"
endi
dift d_pick = 2
'test $IFT,ELSE,ENDI
$inp s_string1, "enter first string"
$inp s_string2, "enter second string"
$ift s_string1 = s_string2
$out "equal"
else
$out "else not equal"
endi
$ift s_string1 < s_string2: $out "less than"
$ift s_string1 <= s_string2
$out "less than or equal to"
endi
$ift s_string1 <> s_string2: $out "not equal"
$ift s_string1 > s_string2: $out "greater than"
$ift s_string1 >= s_string2
$out "greater than or equal to"
endi
endi
dift d_pick = 3
'test DTO$, DED$, $LEN, DPK$, DTOF
$inp s_any,"enter number to format"
d_number1 = 1
$isd d_any, s_any
dift d_any = 1: $tod d_number1, s_any
$inp s_any, "enter total width of number"
d_wide = 1
$isd d_any, s_any
dift d_any = 1: $tod d_wide, s_any
$inp s_any, "enter right of decimal amount"
d_decimals = 1
$isd d_any, s_any
dift d_any = 1: $tod d_decimals, s_any
dto$ s_string1, d_number1, d_wide, d_decimals
ded$ s_string2, d_number1, d_wide, d_decimals
$out "12345678901234567890123456789012345678901234567890"
$out s_string1
$out s_string2
$len d_long, s_string1
$out "DTO$ length=" + d_long
$len d_long, s_string2
$out "DED$ length=" + d_long
dpk$ s_string1, d_number1, d_wide
$out s_string1 + "=DPK$"
dtof s_string2, d_number1, d_wide
$out s_string2 + "=DTOF"
$inp s_any, "return"
endi
dift d_pick = 4
'test $ISD
d_show = 2
$inp s_any, "1=show $TOD,DTO$"
$ift s_any = "1": d_show = 1
d_count = 0
d_part = 0
dwhi d_part < 100
s_any = "0" + d_part
$off s_any, s_any, 2
s_number1 = "123456789." + s_any
$trb s_number1, s_number1
$tod d_number1, s_number1
d_number2 = d_number1 * 100 \ 1 / 100
dto$ s_number2, d_number2, 20, 2
$trb s_number2, s_number2
d_any = 2
$ift s_number1 <> s_number2: d_any = 1
dift d_show = 1: d_any = 1
dift d_any = 1
dinc d_count
$ift s_number1 = s_number2
s_out = d_count + ". equal='"
$app s_out, s_number1 + "', '"
$app s_out, s_number2 + "'"
$out s_out
else
s_out = d_count + ". not equal='"
$app s_out, s_number1 + "', '"
$app s_out, s_number2 + "'"
$out s_out
endi
endi
dinc d_part
endw
$inp s_any, "enter string to test $ISD, $PKD"
$isd d_any, s_any
$out "result=" + d_any
$pkd d_any, d_dot, s_any
$out "$pkd=" + d_dot
$inp s_any, "return"
endi
dift d_pick = 5
'test FWRI,FREA,FLEN
$inp s_filename, "enter filename"
$inp s_record, "enter record"
$inp s_any, "enter byte to write to, file begins at 1"
d_byte = 1
$isd d_any, s_any
dift d_any = 1: $tod d_byte, s_any
$out "s_filename=" + s_filename
$out "s_record=" + s_record
$out "byte=" + d_byte
fwri d_long, s_filename, d_byte, s_record
$out "length written=" + d_long
frea s_record, s_filename, d_byte, d_long
$out s_record
$len d_long, s_record
$out "$len=" + d_long
$inp s_any, "return"
endi
dift d_pick = 6
'test $INS,$REP
s_string1 = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
s_string2="123456789"
$out s_string1
$out s_string2
$inp s_any, "enter number to insert and replace at"
d_byte = 1
$isd d_any, s_any
dift d_any = 1: $tod d_byte, s_any
$out "$INS"
s_any = s_string1
$ins s_any, d_byte, s_string2
$out s_string1
$out s_any
$len d_long, s_any
$out "string length=" + d_long
$out "$REP"
s_any = s_string1
$rep s_any, d_byte, s_string2
$out s_string1
$out s_any
$len d_long, s_any
$out "string length=" + d_long
s_string1 = "20050403"
$out "insert /"
$out s_string1
$ins s_string1, 7, "/"
$ins s_string1, 5, "/"
$out s_string1
$inp s_any, "return"
endi
dift d_pick = 7
'test $DEL
s_string1="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
$out s_string1
$len d_long, s_string1
$out "string length=" + d_long
$inp s_any, "enter begin byte"
d_byte = 1
$isd d_any, s_any
dift d_any = 1: $tod d_byte, s_any
$inp s_any, "enter length"
d_long = 1
$isd d_any, s_any
dift d_any = 1: $tod d_long, s_any
$del s_string1, d_byte, d_long
$out s_string1
$len d_long, s_string1
$out "string length=" + d_long
$out "begin=" + d_byte + ", length=" + d_long
$inp s_any, "return"
endi
dift d_pick = 8
'test $DAT, DSEC
$dat s_any
$out "$DAT=" + s_any
dsec d_any
$out "DSEC=" + d_any
$inp s_any, "return"
endi
dift d_pick = 9
'test FINP,FSIP
$inp s_filename, "FINP enter input filename"
flen d_any, s_filename
$out "FLEN file length=" + d_any
dsec d_seconds
finp s_record, s_filename
dsec d_any
d_seconds = d_any - d_seconds
$out "seconds=" + d_seconds
$len d_any, s_record
$out "$LEN file length=" + d_any
$cut s_any, s_record, 1, 70
$out "1/70 below"
$out s_any
$out "$OFF of 70 below"
$off s_any, s_record, 70
$out s_any
'test FOUT
$inp s_filename, "FOUT enter output filename"
dsec d_seconds
fout d_any, s_filename, s_record
dsec d_dot
d_seconds = d_dot - d_seconds
$out "seconds=" + d_seconds
$out "FOUT length=" + d_any
flen d_any, s_filename
$out "FLEN file length=" + d_any
$len d_any, s_record
$out "$LEN file length=" + d_any
finp s_record, s_filename
$len d_any, s_record
$out "$LEN file length=" + d_any
$inp s_any, "return to $TRB"
$trb s_record, s_record
$inp s_any, "$TRB must have worked"
$cut s_any, s_record, 1, 70
$out "1/70 below"
$out s_any
$out "$OFF of 70 below"
$off s_any, s_record, 70
$out s_any
$inp s_any, "next begin FSIP"
d_byte = 1
d_loop = 1
dwhi d_loop = 1
fsip s_record, s_filename, d_byte
dift d_byte = 0
dinc d_loop
$inp s_any, "return"
else
$len d_long, s_record
$out "d_byte=" + d_byte + ", long=" + d_long
s_dot = "1234567890"
$app s_dot, s_dot
$app s_dot, s_dot
$app s_dot, s_dot
$out s_dot
$out s_record
$inp s_any, "more, * to end"
$ift s_any = "*": dinc d_loop
endi
endw
endi
dift d_pick = 10
'test $lok,$bak
s_number1 = " 1 2 3"
$app s_number1, " 4 5 6"
s_number2 = "123456789012345678901234567890"
$app s_number2, s_number2
s_string1 = "Once upon a midnight dreary, while I "
$app s_string1, "pondered, weak and weary,"
$out s_number1
$out s_number2
$out s_string1
$inp s_string2, "enter string to find"
$inp s_any, "enter byte to start looking"
d_dot = 1
$isd d_any, s_any
dift d_any = 1: $tod d_dot, s_any
$out "byte=" + d_dot
$lok d_number1, s_string1, d_dot, s_string2
$bak d_number2, s_string1, d_dot, s_string2
$out "$lok gives=" + d_number1
$out "$bak gives=" + d_number2
$inp s_any, "return"
endi
dift d_pick = 11
'test $isc
$inp s_string1, "enter string to test"
$inp s_string2, "enter pattern string"
$out s_string1
$out s_string2
$isc d_any, s_string1, s_string2
$out "$isc gives=" + d_any
$inp s_any, "return"
endi
dift d_pick = 12
'test $par
s_string1 = "AB,CD,EFG,H,,IJKLM,OPQ,"
$out s_string1
$inp s_any, "$par choose which"
d_dot = 1
$isd d_any, s_any
dift d_any = 1: $tod d_dot, s_any
$par s_any, s_string1, ",", d_dot
$len d_any, s_any
s_out = "which=" + d_dot
$app s_out, ", string=" + s_any
$app s_out, ", length=" + d_any
$out s_out
$inp s_any, "return"
endi
dift d_pick = 13
'test $sor
s_string1 = "ZYXWVUTSRQPONMLKJIHGFEDCBA987654"
$out s_string1
$out "32 bytes in the string"
$inp s_any, "pick a length 1,2,4,8,16"
d_long = 1
$isd d_any, s_any
dift d_any = 1: $tod d_long, s_any
$sor s_string2, s_string1, d_long
$out s_string1
$out s_string2
$inp s_any, "return"
endi
dift d_pick = 14
'test $out,$sho
$out "we begin now"
d_dot = 0
dwhi d_dot < 10000
dinc d_dot
$sho "count=" + d_dot
endw
$out "we end now"
$inp s_any, "return"
endi
dift d_pick = 15
$inp s_filename, "enter filename to look in"
finp s_filedata, s_filename
$inp s_dot, "enter string to count"
$cnt d_dot, s_filedata, s_dot
$len d_any, s_filedata
$out "file=" + s_filename + ", length=" + d_any
$out "string='" + s_dot + "', count=" + d_dot
$inp s_any, "return"
endi
dift d_pick = 16
'$TOI,ITO$,DTOI,ITOD
$inp s_string1, "string for $TOI"
$inp s_index, "index to go into"
$isd d_any, s_index
d_index = 12345
dift d_any = 1: $tod d_index, s_index
$toi d_index, s_string1
ito$ s_string2, d_index
$inp s_any, "at index=" + d_index + " is=" + s_string2
$inp s_number1, "number to store in array DTOI"
d_number1 = 54321
$isd d_any, s_number1
dift d_any = 1: $tod d_number1, s_number1
$inp s_index, "index to go into"
$isd d_any, s_index
d_index = 12345
dift d_any = 1: $tod d_index, s_index
dtoi d_index, d_number1
itod d_number1, d_index
$inp s_any, "at index=" + d_index + " is=" + d_number1
endi
dift d_pick = 17
'test DFAC,DFAK
$out "DFAC d_answer, d_number1"
$out "DFAK d_answer, d_number1, d_number2"
$inp s_number1, "enter d_number1"
$inp s_number2, "enter d_number2"
d_number1 = 1
$isd d_any, s_number1
dift d_any = 1: $tod d_number1, s_number1
d_number2 = 1
$isd d_any, s_number2
dift d_any = 1: $tod d_number2, s_number2
dsec d_seconds
dfac d_answer, d_number1
dsec d_dot
d_seconds = d_dot - d_seconds
ded$ s_any, d_answer, 0, 0
$out "DFAC gives=" + s_any + " sec=" + d_seconds
dsec d_seconds
dfak d_answer, d_number1, d_number2
dsec d_dot
d_seconds = d_dot - d_seconds
ded$ s_any, d_answer, 0, 0
$out "DFAK gives=" + s_any + " sec=" + d_seconds
$inp s_any, "return"
endi
endw
ends sub_command_test
subr sub_all_teapro_commands_test0
'updated 2007/11/12, 2007/04/10, 2006/10/26
'2006/06/11, 2006/06/04, 2006/06/02, 2006/05/31, 2006/05/25
'2006/05/13, 2006/05/12, 2006/05/01, 2006/04/29, 2006/04/27
'2006/04/23, 2006/04/15, 2006/01/17, 2005/12/04, 2005/11/30
'2005/11/20, 2005/11/02, 2005/10/12, 2005/10/07, 2005/07/30
'2005/07/19, 2005/07/04, 2005/07/03, 2005/07/02, 2005/07/01
'2005/06/26, 2005/06/07, 2005/06/06, 2005/06/05
vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, s_out
dg_more = 1
dift dg_more = 1
dg_errorct = 0
dg_step = 2
sg_numbers = "1234567890123456789012345678901234567890"
$app sg_numbers, sg_numbers
sg_alphanum = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
$clo s_any, sg_alphanum
$app sg_alphanum, s_any
endi
dift dg_more = 1
'decimal commands
sub_all_teapro_commands_test1
endi
dift dg_more = 1
'string commands
sub_all_teapro_commands_test2
endi
dift dg_more = 1
'array commands
sub_all_teapro_commands_test3
endi
dift dg_more = 1
'file commands
sub_all_teapro_commands_test4
endi
dift dg_more = 1
'control commands goto,gtag
sub_all_teapro_commands_test5
endi
'output version of teapro.exe
$sys s_any, 3
$out s_any
$out sg_build
$out "error count=" + dg_errorct
$inp s_any, "done"
ends sub_all_teapro_commands_test0
subr sub_all_teapro_commands_test1
'updated 2007/07/08, 2007/05/06
'2007/04/16, 2007/02/28, 2007/01/20, 2006/11/12, 2006/06/11
'decimal commands
vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, s_out
vari d_good, d_bigstring, s_prime
vari d_num1, d_num2, d_num3
vari s_num1, s_num2, s_num3
dift dg_more = 1
d_bigstring = 90000 * 10
endi
dift dg_more = 1
$out "DABS"
dran d_dot
d_any = - d_dot
dabs d_any, d_any
dift d_any = d_dot
$out "DABS is ok"
else
$out "DABS is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "DARC, DSIN"
dran d_num1
dto$ s_num1, d_num1, 0, 0
darc d_num2, d_num1
dto$ s_num2, d_num2, 0, 0
$out "DARC of=" + s_num1 + " is=" + s_num2
dsin d_num3, d_num2
dto$ s_num3, d_num3, 0, 0
$out "DSIN of=" + s_num2 + " is=" + s_num3
$cut s_num1, s_num1, 1, 15
$cut s_num3, s_num3, 1, 15
$ift s_num1 = s_num3
$out "DARC,DSIN are ok"
else
$out "DARC,DSIN are not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "DBUG"
dbug
d_any = 1 / 7
$out "1/7=" + d_any
dbug
endi
dift dg_more = 1
$out "DCH$"
d_good = 1
dch$ s_any, 65, d_bigstring
$len d_any, s_any
$out "$len should be " + d_bigstring + " and is=" + d_any
dift d_any <> d_bigstring: dinc d_good
$cnt d_dot, s_any, "A"
$out "$cnt should be " + d_bigstring + " and is=" + d_dot
dift d_any <> d_bigstring: dinc d_good
dch$ s_any, 65, 0
$len d_any, s_any
$out "$len should be zero and is=" + d_any
dift d_any <> 0: dinc d_good
dift d_good = 1
$out "dch$ is ok"
else
$out "dch$ is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "DED$"
d_num1 = - 12345 * 10000 - 6789 / 100
ded$ s_any, d_num1, 0, 2
$out sg_numbers
$out d_num1
$out s_any
$ift s_any = "-1,234,567.89"
$out "ded$ is ok"
else
$out "ded$ is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "DFAC"
s_prime = "9,002,235,408,655,631"
$out s_prime
$tod d_num1, s_prime
dfac d_dot, d_num1
dift d_dot <> 1
ded$ s_any, d_dot, 0, 0
$out s_any + " is not 1"
$out "dfac is not ok"
dinc dg_errorct
sub_more
else
$out "dfac is ok"
endi
endi
dift dg_more = 1
$out "DFAK"
s_prime = "99,996,530,453,619,851"
$out s_prime
$cut s_any, s_prime, 4, 99
$tod d_num1, s_any
dfak d_dot, d_num1, 99
dift d_dot <> 1
ded$ s_any, d_dot, 0, 0
$out s_any + " is not 1"
$out "dfak is not ok"
dinc dg_errorct
sub_more
else
$out "dfak is ok"
endi
endi
dift dg_more = 1
$out "DLOG,DPOW"
dran d_num1
d_num1 = d_num1 * 99999
dto$ s_num1, d_num1, 0, 0
dlog d_num2, d_num1
dto$ s_num2, d_num2, 0, 0
$out "DLOG of=" + s_num1 + " is=" + s_num2
'test dpow and ^ both
dpow d_num3, 10, d_num2
d_any = 10 ^ d_num2
dift d_any <> d_num3: d_num3 = - 15 / 2
dto$ s_num3, d_num3, 0, 0
$out "DPOW of 10^" + s_num2 + " is=" + s_num3
$cut s_num3, s_num3, 1, 15
$cut s_num1, s_num1, 1, 15
$ift s_num3 = s_num1
$out "DLOG,DPOW are ok"
else
$out "DLOG,DPOW are not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "DPK$"
d_num1 = - 12345
dpk$ s_num1, d_num1, 5
$out s_num1
$out d_num1
$ift s_num1 = "1234N"
$out "dpk$ is ok"
else
$out "dpk$ is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "DSET"
d_tap = 1
d_dot = 1.23456789 + 6.0 * 2.5 @ 3
d_num1 = 1.23456789
d_num2 = 6
d_num3 = 2.5
d_any = d_num1 + d_num2 * d_num3 @ 3
dto$ s_dot, d_dot, 20, 15
dto$ s_any, d_any, 20, 15
$out s_dot + "=" + s_any
dift d_dot <> d_any: dinc d_tap
d_dot = d_num1 ? 5
d_any = 1.23456789 ? 5
dto$ s_dot, d_dot, 20, 15
dto$ s_any, d_any, 20, 15
$out s_dot + "=" + s_any
dift d_dot <> d_any: dinc d_tap
dift d_tap = 1
$out "dset is ok"
else
$out "dset is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "DTO$"
d_num1 = - 12345 * 10000 - 6789 / 100
dto$ s_num1, d_num1, 0, 2
$out sg_numbers
$out d_num1
$out s_num1
$ift s_num1 = "-1234567.89"
$out "dto$ is ok"
else
$out "dto$ is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "DTOF"
d_num1 = - 12345 * 10000 - 6789
dtof s_any, d_num1, 12
$out sg_numbers
$out d_num1
$out s_any
$ift s_any = "-00123456789"
$out "dtof is ok"
else
$out "dtof is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
ends sub_all_teapro_commands_test1
subr sub_all_teapro_commands_test2
'updated 2008/01/30, 2006/06/11
'string commands
vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, s_out
vari s_date, d_good
vari d_num1, d_num2, d_num3
vari s_num1, s_num2, s_num3
vari s_string1, s_string2
dift dg_more = 1
$out "$APP"
d_any = - 432 / 1000 - 765
s_any = "ABC"
$app s_any, "DEF" + "12345" + "6" + s_any + d_any
s_dot = sg_nothing
$app s_dot, s_any + s_dot
$out s_any
$out "ABCDEF123456ABC-765.432"
$ift s_any = "ABCDEF123456ABC-765.432"
$out "$app is ok"
else
$out "$app is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$BAK"
$bak d_any, sg_alphanum, 36, "OPQ"
$out sg_numbers
$out sg_alphanum
$out "found 'OPQ' at=" + d_any
dift d_any = 15
$out "$bak is ok"
else
$out "$bak is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$BES"
dch$ s_any, 0, 40
$bes s_any, s_any
$cnt d_any, s_any, " "
dift d_any = 40: $len d_any, s_any
dift d_any = 40
$out "$bes is ok"
else
$out "$bes is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$CH$"
$ch$ s_any, "A", 40
$len d_any, s_any
dift d_any = 40: $cnt d_any, s_any, "A"
$out sg_numbers
$out s_any
dift d_any = 40
$out "$ch$ is ok"
else
$out "$ch$ is not ok, 40 of 'A'"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$CHD"
$chd d_any, "A"
$out "A is=" + d_any
dift d_any = 65
$out "$chd is ok"
else
$out "$chd is not ok, A is 65"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$CLO"
s_dot = "ABCDEFGhij123"
$clo s_any, s_dot
$out s_dot
$out s_any
$ift s_any = "abcdefghij123"
$out "$clo is ok"
else
$out "$clo is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$CNT"
s_any = "AB12AB234AB5A6B"
$cnt d_any, s_any, "AB"
$out s_any
$out "count=" + d_any
dift d_any = 3
$out "$cnt is ok"
else
$out "$cnt is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$COD"
s_any = sg_alphanum
$clo s_dot, s_any
$app s_any, s_dot
$cod s_dot, s_any
$cod s_tap, s_dot
$out "$COD beg=" + s_any
$out "$COD end=" + s_dot
$out "$COD beg=" + s_tap
$ift s_any = s_tap
$out "$COD is ok"
else
$out "$COD is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$CUP"
s_dot = "abcDEFghi123"
$cup s_any, s_dot
$out s_dot
$out s_any
$ift s_any = "ABCDEFGHI123"
$out "$cup is ok"
else
$out "$cup is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$CUT"
$cut s_any, sg_alphanum, 10, 5
$out sg_numbers
$out sg_alphanum
$out s_any
$out "10 for 5"
$ift s_any = "JKLMN"
$out "$cut is ok"
else
$out "$cut is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$DAT"
'12345678901234567890123456789012345
'22-MAR-2002 21:28:16 20020322212816
$dat s_date
$out sg_numbers
$out s_date
d_dot = 1
$cut s_any, s_date, 1, 2
$cut s_dot, s_date, 28, 2
$ift s_any <> s_dot: dinc d_dot
$cut s_any, s_date, 8, 4
$cut s_dot, s_date, 22, 4
$ift s_any <> s_dot: dinc d_dot
$cut s_any, s_date, 13, 8
$del s_any, 6, 1
$del s_any, 3, 1
$cut s_dot, s_date, 30, 6
$ift s_any <> s_dot: dinc d_dot
$len d_any, s_date
dift d_any <> 35: dinc d_dot
dift d_dot = 1
$out "$dat is ok"
else
$out "$dat is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$DEL"
s_any = sg_alphanum
$del s_any, 4, 66
$out sg_numbers
$out sg_alphanum
$out s_any
$out "delete 4 for 66"
$ift s_any = "ABC789"
$out "$del is ok"
else
$out "$del is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$DOT"
s_dot = "a,,bc,,def,,ghijk,,lmn,o,,,p"
$dot d_dot, s_dot, ",,", 4
$dot d_any, s_dot, ",,", 5
d_dot = d_dot * d_any
d_any = 18 * 25
$out sg_numbers
$out s_dot
$out "$dot find 4th and 5th ,,"
dift d_dot = d_any
$out "$dot is ok"
else
$out "$dot is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$HSH"
$hsh d_any, sg_alphanum
$out sg_numbers
$out sg_alphanum
ded$ s_any, d_any, 0, 0
$out "hash=" + s_any
dift d_any = 5984225822
$out "$hsh is ok"
else
$out "$hsh is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$INS"
s_any = "ABC123"
s_dot = s_any
$ins s_any, 4, "DEFG"
$out sg_numbers
$out s_dot
$out s_any
$out "insert at 4 'DEFG'"
$ift s_any = "ABCDEFG123"
$out "$ins is ok"
else
$out "$ins is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$ISC"
$ch$ s_any, "a", 40
s_dot = s_any
$ins s_any, 4, "A"
$isc d_dot, s_dot, "a"
$isc d_any, s_any, "a"
$out sg_numbers
$out s_dot
$out s_any
$out "$isc: top is 40 of 'a', bottom is not"
d_any = d_any * 10 + d_dot
dift d_any = 21
$out "$ins is ok"
else
$out "$ins is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$ISD"
s_any = "-1,234,567.89"
s_dot = s_any
$ins s_any, 4, "A"
$isd d_dot, s_dot
$isd d_any, s_any
$out sg_numbers
$out s_dot
$out s_any
$out "$isd: top is decimal, bottom is not"
d_any = d_any * 10 + d_dot
dift d_any = 21
$out "$isd is ok"
else
$out "$isd is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$ISP"
s_tap = "12 ABCdef*&^"
s_any = "56 DEFghi,.:"
s_dot = s_any
$rep s_any, 4, "@"
$isp d_dot, s_dot, s_tap
$isp d_any, s_any, s_tap
$out sg_numbers
$out s_dot
$out s_any
$out "$isp: top is same pattern, bottom is not"
d_any = d_any * 10 + d_dot
dift d_any = 21
$out "$isp is ok"
else
$out "$isp is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$IST"
s_tap = sg_nothing
s_any = "1234567890"
s_dot = s_any
$rep s_any, 4, "@"
$ist d_dot, s_dot, "9"
$ist d_any, s_any, "9"
$ist d_tap, s_tap, "9"
$out "$ist testing for numbers"
$out "top='" + s_dot + "' $ist gives=" + d_dot
$out "mid='" + s_any + "' $ist gives=" + d_any
$out "bot='" + s_tap + "' $ist gives=" + d_tap
$out "$ist: top is same type, mid is not, bottom is empty"
d_any = d_dot * 10 + d_any * 10 + d_tap
dift d_any = 122
$out "$ist is ok"
else
$out "$ist is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$LEN"
$len d_any, sg_alphanum
$out sg_numbers
$out sg_alphanum
$out "length=" + d_any
dift d_any = 72
$out "$len is ok"
else
$out "$len is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$LOK"
$lok d_any, sg_alphanum, 1, "OPQ"
$out sg_numbers
$out sg_alphanum
$out "found 'OPQ' at=" + d_any
dift d_any = 15
$out "$lok is ok"
else
$out "$lok is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$OFF"
$off s_any, sg_alphanum, 7
$out sg_numbers
$out sg_alphanum
$out s_any
$out "$off: 7 long"
$ift s_any = "3456789"
$out "$off is ok"
else
$out "$off is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$PAR"
s_dot = "1,23,456,ABC, ,"
$par s_any, s_dot, ",", 3
$out sg_numbers
$out s_dot
$out s_any
$out "$par: occurrence 3"
$ift s_any = "456"
$out "$par is ok"
else
$out "$par is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
s_dot = "123456"
$par s_any, s_dot, ",", 1
$out sg_numbers
$out s_dot
$out s_any
$out "$par: occurrence 1"
$ift s_any = s_dot
$out "$par is ok"
else
$out "$par is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$PKD"
'yes
d_num1 = - 12345 * 10000 - 6789
s_num2 = "12345678R"
d_good = 1
d_num3 = -12345
d_num2 = 55555
$pkd d_num3, d_num2, s_num2
dift d_num3 <> 1: dinc d_good
dift d_num2 <> d_num1: dinc d_good
s_out = "$pkd " + s_num2 + " gives result=" + d_num2
$app s_out, " with yesno=" + d_num3
$out s_out
$out "yesno should=1 and the result should be=" + d_num1
dift d_good = 1
$out "$pkd is ok"
else
$out "$pkd is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$PKD"
'no
d_num1 = - 12345 * 10000 - 6789
s_num2 = "12345678*"
d_good = 1
d_num3 = -12345
d_num2 = 55555
$pkd d_num3, d_num2, s_num2
dift d_num3 <> 2: dinc d_good
dift d_num2 <> 55555: dinc d_good
s_out = "$pkd " + s_num2 + " gives result=" + d_num2
$app s_out, " with yesno=" + d_num3
$out s_out
$out "yesno should=2 and the result should be=55555"
dift d_good = 1
$out "$pkd is ok"
else
$out "$pkd is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$REP"
s_any = "ABC123"
s_dot = s_any
$rep s_any, 4, "xyz"
$out sg_numbers
$out s_dot
$out s_any
$out "$rep: replace at 4 'xyz'"
$ift s_any = "ABCxyz"
$out "$rep is ok"
else
$out "$rep is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$SET"
s_dot = "g" + "h"
$set s_any = "a" + "bc" + 1 + "def" + 23 + s_dot
$ift s_any = "abc1def23gh"
$out "$SET is ok"
else
$out "$SET is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$SOR"
s_dot = "OKLAHOMA1907"
$sor s_string1, s_dot, 2
$out sg_numbers
$out s_dot
$out s_string1
$out "$sor: sort by 2"
s_any = s_string1
s_dot = "OKLAHOMA1907"
$sor s_string2, s_dot, 4
$out sg_numbers
$out s_dot
$out s_string2
$out "$sor: sort by 4"
$app s_any, s_string2
$ift s_any = "0719HOLAMAOK1907HOMAOKLA"
$out "$sor is ok"
else
$out "$sor is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$SWP"
s_dot = "abcabdabcdeab"
s_any = s_dot
s_tap = "ab"
$swp s_any, s_tap, "xyz"
$out sg_numbers
$out s_dot
$out s_any
$out "$swp: swap 'ab' to 'xyz'"
$ift s_any = "xyzcxyzdxyzcdexyz"
$out "$swp is ok"
else
$out "$swp is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$TLO"
s_dot = " ABCdefg "
$tlo s_any, s_dot
$out sg_numbers
$out "'" + s_dot + "'"
$out "'" + s_any + "'"
$out "$tlo: trim low"
$ift s_any = "abcdefg"
$out "$tlo is ok"
else
$out "$tlo is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$TOD"
s_any = "-1,234,567.89"
$tod d_any, s_any
ded$ s_dot, d_any, 0, 2
$out s_any
$out s_dot
$ift s_any = s_dot
$out "$tod is ok"
else
$out "$tod is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$TOE"
s_tap = "apple"
$toe s_any, sg_alphanum, s_tap, 1
$out s_any
$toe s_dot, s_any, s_tap, 2
$out s_dot
$out sg_alphanum
$ift s_dot = sg_alphanum
$out "$toe is ok"
else
$out "$toe is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$TOI"
d_any = 1234
$toi d_any, sg_alphanum
ito$ s_any, d_any
$out sg_alphanum
$out s_any
$ift s_any = sg_alphanum
$out "$toi is ok"
else
$out "$toi is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$TRB"
s_dot = " ABCdefg "
$trb s_any, s_dot
$out sg_numbers
$out "'" + s_dot + "'"
$out "'" + s_any + "'"
$out "$trb: trim both"
$ift s_any = "ABCdefg"
$out "$trb is ok"
else
$out "$trb is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$TRL"
s_dot = " ABCdefg "
$trl s_any, s_dot
$out sg_numbers
$out "'" + s_dot + "'"
$out "'" + s_any + "'"
$out "$trl: trim both"
$ift s_any = "ABCdefg "
$out "$trl is ok"
else
$out "$trl is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$TRR"
s_dot = " ABCdefg "
$trr s_any, s_dot
$out sg_numbers
$out "'" + s_dot + "'"
$out "'" + s_any + "'"
$out "$trr: trim both"
$ift s_any = " ABCdefg"
$out "$trr is ok"
else
$out "$trr is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$TUP"
s_dot = " ABCdefg "
$tup s_any, s_dot
$out sg_numbers
$out "'" + s_dot + "'"
$out "'" + s_any + "'"
$out "$tup: trim both"
$ift s_any = "ABCDEFG"
$out "$tup is ok"
else
$out "$tup is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "$WHI"
s_any = "ABCD"
d_any = 0
d_num1 = 10000
$whi s_any = "ABCD"
dinc d_any
d_dot = d_any % 100
dift d_dot = 0: $sho "testing $whi=" + d_any
dift d_any > d_num1: s_any = "ABC"
endw
$out "$whi is ok"
dift dg_step = 1: sub_more
endi
'string commands above
ends sub_all_teapro_commands_test2
subr sub_all_teapro_commands_test3
'updated 2007/11/18, 2006/06/11
'array commands
vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, s_out
vari d_index
vari d_num1, d_num2
dift dg_more = 1
$out "ITO$"
d_any = 1234
$toi d_any, sg_alphanum
ito$ s_any, d_any
$out sg_alphanum
$out s_any
$ift s_any = sg_alphanum
$out "ito$ is ok"
else
$out "ito$ is not ok"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "array commands below"
$out "ADDI,ARRZ,DTOI,ITOD"
arrz
d_index = 1
dwhi d_index <= 8000
dtoi d_index, d_index
addi d_index, d_index
dinc d_index
endw
d_index = 8000
dwhi d_index > 0
itod d_num1, d_index
d_num2 = d_index * 2
dift d_num1 <> d_num2
s_out = "decimal array error "
$app s_out, d_num1 + "<>" + d_num2
$app s_out, " index=" + d_index
$out s_out
dinc dg_errorct
sub_more
dift dg_more <> 1: d_index = 0
endi
ddec d_index
endw
dift dg_step = 1: sub_more
endi
ends sub_all_teapro_commands_test3
subr sub_all_teapro_commands_test4
'updated 2006/06/11
'file commands
vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, s_out
vari s_filename, s_record, s_line, d_filebyte
vari d_long, d_good
dift dg_more = 1
$out "file commands below"
s_record = "ABCDEFGHIJKLM"
s_filename = "17760704.txt"
fdel d_any, s_filename
flen d_long, s_filename
dift d_long > 0
$out "fdel or flen err"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "FAPP"
d_good = 1
fdel d_any, s_filename
fapp d_long, s_filename, s_record
$out "fapp len=" + d_long
dift d_long <> 15: dinc d_good
flen d_long, s_filename
$out "fapp flen=" + d_long
dift d_long <> 15: dinc d_good
dift d_good <> 1
$out "err fapp length"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "FADD"
d_good = 1
fdel d_any, s_filename
fadd d_long, s_filename, s_record
$out "fadd len=" + d_long
dift d_long <> 14: dinc d_good
flen d_long, s_filename
$out "fadd flen=" + d_long
dift d_long <> 14: dinc d_good
dift d_good <> 1
$out "err fadd length"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "FSIP after four FAPP"
s_record = "ABCDEFGHIJKLM"
s_filename = "17760704.txt"
d_good = 1
fdel d_any, s_filename
fapp d_long, s_filename, s_record
fapp d_long, s_filename, s_record
fapp d_long, s_filename, s_record
fapp d_long, s_filename, s_record
d_filebyte = 1
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out "1234567890123"
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 13: dinc d_good
dift d_filebyte <> 16: dinc d_good
$out "correct is 13 and 16"
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 13: dinc d_good
dift d_filebyte <> 31: dinc d_good
$out "correct is 13 and 31"
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 13: dinc d_good
dift d_filebyte <> 46: dinc d_good
$out "correct is 13 and 46"
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 13: dinc d_good
dift d_filebyte <> 61: dinc d_good
$out "correct is 13 and 61"
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 0: dinc d_good
dift d_filebyte <> 0: dinc d_good
$out "correct is 0 and 0"
dift d_good <> 1
$out "err fsip"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
$out "FSIP after four FADD"
d_good = 1
fdel d_any, s_filename
fadd d_long, s_filename, s_record
fadd d_long, s_filename, s_record
fadd d_long, s_filename, s_record
fadd d_long, s_filename, s_record
d_filebyte = 1
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 13: dinc d_good
dift d_filebyte <> 15: dinc d_good
$out "correct is 13 and 15"
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 13: dinc d_good
dift d_filebyte <> 29: dinc d_good
$out "correct is 13 and 29"
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 13: dinc d_good
dift d_filebyte <> 43: dinc d_good
$out "correct is 13 and 43"
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 13: dinc d_good
dift d_filebyte <> 57: dinc d_good
$out "correct is 13 and 57"
endi
dift dg_more = 1
fsip s_line, s_filename, d_filebyte
$len d_long, s_line
$out s_line
$out "fsip $len=" + d_long + ", byte=" + d_filebyte
dift d_long <> 0: dinc d_good
dift d_filebyte <> 0: dinc d_good
$out "correct is 0 and 0"
dsys d_any, 1
ded$ s_any, d_any, 0, 0
$out "memory=" + s_any
dift d_good <> 1
$out "err fsip"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
endi
dift dg_more = 1
fdel d_any, s_filename
endi
ends sub_all_teapro_commands_test4
subr sub_all_teapro_commands_test5
'updated 2007/04/11, 2007/04/10
'control commands
vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, s_out
dpow d_dot, 10, 7
d_any = 0
dsec d_tap
gtag tag_loop
dinc d_any
dift d_any < d_dot: goto tag_loop
dift d_any = d_dot
$out "goto,gtag are good=" + d_any
dsec d_any
d_tap = d_any - d_tap
$out "seconds=" + d_tap
else
$out "err goto,gtag"
dinc dg_errorct
sub_more
endi
dift dg_step = 1: sub_more
ends sub_all_teapro_commands_test5
subr sub_more
'updated 2006/04/23
vari s_any
dift dg_more = 1
$inp s_any, "more, * to end"
$trb s_any, s_any
$ift s_any = "*": dinc dg_more
endi
ends sub_more
subr sub_test_big_strings
'updated 2008/01/30, 2005/08/23
vari d_any, s_any, d_dot, s_dot
vari s_string1, s_string2
vari d_long
d_long = 2000 * 2000
$out "long=" + d_long
$ch$ s_any, " ", d_long
s_string1 = s_any + "OKLAHOMA" + s_any
$out "4M blanks + 'OKLAHOMA' + 4M blanks"
$len d_any, s_string1
$out "$trl on big string long=" + d_any
$trl s_string2, s_string1
$len d_any, s_string2
$out "long=" + d_any
$len d_any, s_string1
$out "$trr on big string long=" + d_any
$trr s_string2, s_string1
$len d_any, s_string2
$out "long=" + d_any
$len d_any, s_string1
$out "$trb on big string long=" + d_any
$trb s_string2, s_string1
$len d_any, s_string2
$out "long=" + d_any
$inp s_any, "done"
ends sub_test_big_strings
subr sub_test_arithmetic
'updated 2007/05/04, 2007/04/11, 2005/03/31, 2005/02/27
'2005/02/13, 2005/02/11, 2005/02/10, 2004/11/30
'test arithmetic
vari d_any, s_any, d_dot, s_dot
vari d_loop, d_number1, d_number2, d_result
vari s_operator
$sys s_any, 2
$out s_any
$out "test arithmetic"
'd_loop is for looping
d_loop = 1
dwhi d_loop = 1
$out "12345678901234567890"
$inp s_any, "first number, default=" + d_number1
$isd d_any, s_any
dift d_any = 1: $tod d_number1, s_any
'are we done
'an asterisk is char 42
$ift s_any = "*": d_loop = 2
$out "12345678901234567890"
$inp s_any, "second number, dfault=" + d_number2
$isd d_any, s_any
dift d_any = 1: $tod d_number2, s_any
'are we done
'an asterisk is char 42
$ift s_any = "*": d_loop = 2
d_result = 0
s_operator = " "
dift d_loop = 1
$out "enter the letter 'B' to test dbad"
$inp s_operator, "enter operator: +,-,*,/,\,%,@,?,^"
endi
$ift s_operator = "B": dbad d_number1 = d_number2
'a plus is char 43
$ift s_operator = "+"
'first number is d_number1, second is d_number2
$out "addition"
d_result = d_number1 + d_number2
endi
'a minus is char 45
$ift s_operator = "-"
'first number is d_number1, second is d_number2
$out "subtraction"
d_result = d_number1 - d_number2
endi
'an asterisk is char 42
$ift s_operator = "*"
'first number is d_number1, second is d_number2
$out "multiplication"
d_result = d_number1 * d_number2
endi
'a slash is char 47
$ift s_operator = "/"
'first number is d_number1, second is d_number2
$out "division"
d_result = d_number1 / d_number2
endi
'a back slash is char 92
$ift s_operator = "\"
'first number is d_number1, second is d_number2
$out "integer division"
d_result = d_number1 \ d_number2
endi
'a mod operator is char 37
$ift s_operator = "%"
'first number is d_number1, second is d_number2
$out "modulus"
d_result = d_number1 % d_number2
endi
'a caret is char 94
$ift s_operator = "^"
'first number is d_number1, second is d_number2
$out "exponentiation using DPOW"
dpow d_result, d_number1, d_number2
endi
'an at sign is char 64
$ift s_operator = "@"
'first number is d_number1, second is d_number2
$out "round"
d_result = d_number1 @ d_number2
endi
'a question mark is char 63
$ift s_operator = "?"
'first number is d_number1, second is d_number2
$out "truncate"
d_result = d_number1 ? d_number2
endi
dift d_loop = 1
dabs d_any, d_result
ded$ s_any, d_any, 20, 20
$out "dabs of d_result gives=" + s_any
$out "dabs of d_result gives=" + d_any
drou d_any, d_result
ded$ s_any, d_any, 20, 20
$out "drou of d_result gives=" + s_any
$out "drou of d_result gives=" + d_any
dtru d_any, d_result
ded$ s_any, d_any, 20, 20
$out "dtru of d_result gives=" + s_any
$out "dtru of d_result gives=" + d_any
$out "operator=" + s_operator
$out " " + "12345678901234567890"
$out "first =" + d_number1
$out "second=" + d_number2
$out "result=" + d_result
$inp s_any, "return, * to end"
'are we done
'an asterisk is char 42
$ift s_any = "*": d_loop = 2
endi
endw
ends sub_test_arithmetic
subr sub_recursion
'updated 2005/02/13
vari d_number, s_any
$out "dg_pass1=" + dg_pass1
d_number = dg_pass1 - 1
dg_pass1 = d_number
dift d_number > 0: sub_recursion
$out "number=" + d_number + ", dg_pass1=" + dg_pass1
$inp s_any, "return"
ends sub_recursion
subr sub_xyz_math
'updated 2007/09/12, 2007/04/11, 2006/05/04
'2006/04/08, 2005/11/05, 2005/08/20, 2005/06/11, 2004/04/21
'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, s_lok
vari d_good, d_long, d_loop, d_error, s_dashes
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
$tup s_line, s_command
$ch$ s_dashes, "-", 70
$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
$swp s_line, ",", sg_nothing
$swp s_line, " ", sg_nothing
'colon delimited into sg_xyzmath
'which holds all xyz commands to show later
$app sg_xyzmath, s_line + ":"
'remove the x= or y= at the beginning in s_work
$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_lok = "+-*/\%^@;"
$lok d_any, s_lok, 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,y,z
$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
$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
'show values
ded$ s_any, dg_xvalue, 0, 0
s_out = "x=" + s_any
dift dg_xvalue > 1
d_any = dg_xvalue \ 1
dift dg_xvalue = d_any
dfac d_any, dg_xvalue
dift d_any = 1: $app s_out, ":P"
endi
endi
ded$ s_any, dg_yvalue, 0, 0
$app s_out, ", y=" + s_any
dift dg_yvalue > 1
d_any = dg_yvalue \ 1
dift dg_yvalue = d_any
dfac d