'tinytea.tea is an interpreter of the Teapro programming language
'People need computer software that actually works.
vari dg_pass1, dg_pass2, dg_pass3
vari sg_pass1, sg_pass2, sg_pass3
vari sg_interpreter, sg_path, sg_build, sg_memory, sg_lines
vari sg_loadprog, sg_nothing, dg_more
vari dg_xvalue, dg_yvalue, dg_zvalue, sg_xyzmath
vari dg_uvalue, dg_vvalue, dg_wvalue

'below for sub_all_teapro_commands_test0 etc
vari dg_errorct, sg_numbers, sg_alphanum, dg_step

sub_main
endp

subr sub_main
'updated 2011/09/26, 2011/01/07
'2010/06/03, 2010/05/10, 2010/05/01, 2010/04/17, 2010/02/04
'2010/01/12, 2009/05/07, 2009/04/02, 2009/03/08, 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, s_speedquick

    sg_nothing = " "
    $trb sg_nothing, sg_nothing
    $ch$ s_aster, "*", 70

    $sys sg_interpreter, 3
    $trb sg_interpreter, sg_interpreter

    d_loop = 1
    dwhi d_loop = 1
	  $sys sg_path, 1
	  $trb sg_path, sg_path


sg_build = "tinytea.tea build=404 2011/12/03"
dsys d_any, 3
$app sg_build, " " + d_any
$out sg_build
$out "tinytea.tea copyright (c) 2004-2011 by D La Pierre Ballard"
$out "tinytea.tea was begun on 2004/11/14"
$out "written 2004-2011 by D La Pierre Ballard"
$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 = "People need computer software 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
	  s_speedquick = sg_pass1

	  dsys d_any, 1
	  ded$ sg_memory, d_any, 0, 0

	  dsys d_any, 2
	  ded$ sg_lines, d_any, 0, 0

        $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 "29. sub_menu_various_tests"
        $out "31. test various commands"
	  $out "32. sub_all_teapro_commands_test0"
	  $out "33. test all teapro commands step"
	  $out "34. test big strings"
	  $out "35. sub_test_speed_of_some_code"
	  $out "37. sub_test_beyond_limits"
        $out "41. sub_test_arithmetic"
	  $out "51. recursion test"
	  $out "61. floating point accuracy test"
$out "85. sub_test_speed_of_dift " + sg_path + " " + sg_lines
$out "96. xyz math           " + sg_interpreter + " " + sg_memory
$out "98. sub_speed98_test   " + sg_build + " " + sg_loadprog
$out "99. sub_speed_test     " + s_speedquick    
s_out = "pick a number *=end" + " x=" + dg_xvalue
	  dsec d_any
	  $inp s_pick, s_out + " " + d_any

	  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

	  'sub_menu_various_tests
	  dift d_pick = 29: sub_menu_various_tests

        '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

	  'sub_test_speed_of_some_code
	  dift d_pick = 35: sub_test_speed_of_some_code

	  '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

	  'test speed of dift
	  dift d_pick = 85: sub_test_speed_of_dift

	  dift d_pick = 96
		sg_pass1 = "x=x"
		sub_xyz_math
	  endi

        '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_menu_various_tests
'updated 2010/01/12
    vari s_pick, d_pick

    $out "1. sub_change_tpd_by_ratio"
    $inp s_pick, "choose"
    $ift s_pick = "1": sub_change_tpd_by_ratio
ends sub_menu_various_tests


subr sub_change_tpd_by_ratio
'updated 2010/01/12
    vari s_any, d_any, s_dot, d_dot, s_out
    vari d_averagetpd, d_rationumber, d_newtpd
    vari d_loop, d_count, d_process
    d_process = 1
    dift d_process = 1
	  $out "tpd = trillion per day"
	  $inp s_dot, "enter begin average tpd"
	  $ift s_dot = "*": dinc d_process
	  $isd d_any, s_dot
	  dift d_any = 1: $tod d_averagetpd, s_dot
	  dift d_any <> 1: dinc d_process
    endi    
    dift d_process = 1
	  $inp s_dot, "enter ratio number ie 6, 8, 12"
	  $ift s_dot = "*": dinc d_process
	  $isd d_any, s_dot
	  dift d_any = 1: $tod d_rationumber, s_dot
	  dift d_any <> 1: dinc d_process
    endi
    dift d_process = 1
	  $inp s_dot, "enter new value of tpd"
	  $ift s_dot = "*": dinc d_process
	  $isd d_any, s_dot
	  dift d_any = 1: $tod d_newtpd, s_dot
	  dift d_any <> 1: dinc d_process
    endi

    d_count = 0
    d_loop = d_process
    dwhi d_loop = 1
	  d_dot = d_rationumber - 1
	  d_any = d_newtpd / d_rationumber
	  d_averagetpd = d_averagetpd * d_dot / d_rationumber + d_any

	  $out d_count + ". " + d_averagetpd

	  dinc d_count
	  d_any = d_count % 10
	  dift d_any = 0
		$inp s_any, "return for more * to end"
		$ift s_any = "*": dinc d_loop
	  endi

    endw
ends sub_change_tpd_by_ratio


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 2011/09/19
'2009/01/25, 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 = 20000

    '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 2011/09/19, 2009/08/04, 2009/01/25
'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 = 20000
    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 2011/09/19, 2009/08/04, 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 = 23456
        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 = 23456
        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 2009/08/04, 2008/12/06
'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,DDUO"
        $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 = 9876
		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 = 9876
		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,DDUO
		$out "DFAC d_answer, d_number1"
		$out "DFAK d_answer, d_number1, d_number2"
		$out "DDUO 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

		dsec d_seconds
		dduo d_answer, d_number1, d_number2
		dsec d_dot
		d_seconds = d_dot - d_seconds
		ded$ s_any, d_answer, 0, 0
		$out "DDUO gives=" + s_any + " sec=" + d_seconds

		$inp s_any, "return"
	  endi
    endw
ends sub_command_test


subr sub_all_teapro_commands_test0
'updated 2011/09/26, 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 + " " + sg_loadprog

    $out "error count=" + dg_errorct
    $inp s_any, "done"
ends sub_all_teapro_commands_test0


subr sub_all_teapro_commands_test1
'updated 2011/05/10, 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 "DBAD"
	  d_any = 1
	  dbad d_any = 0
	  dbad d_any < 1
	  dbad d_any > 1
	  $inp s_any, "1=do a bad DBAD"
	  $ift s_any = "1": dbad d_any = 1
    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 "DCUT"
	  s_any = "12345678901234567890"
	  dcut d_any, s_any, 7, 5
        $out d_any + " should be 78901"
	  dift d_any = 78901
		$out "dcut is ok"
	  else
		$out "dcut 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 "DDUO"
	  s_prime = "99,996,530,453,619,851"
	  $out s_prime
	  $cut s_any, s_prime, 4, 99
	  $tod d_num1, s_any
	  dduo d_dot, d_num1, 99
	  dift d_dot <> 1
		ded$ s_any, d_dot, 0, 0
		$out s_any + " is not 1"
	      $out "dduo is not ok"
	      dinc dg_errorct
		sub_more
	  else
		$out "dduo 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 2011/08/25, 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

	  d_dot = 5984423294
	  ded$ s_dot, d_dot, 0, 0
	  $out "hash should be=" + s_dot

        dift d_any = d_dot
	      $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

    $len d_dot, s_dot
    $out s_dot + " length=" + d_dot

    $len d_any, s_any
    $out s_any + " length=" + d_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

    $len d_dot, s_dot
    $out s_dot + " length=" + d_dot

    $len d_any, s_any
    $out s_any + " length=" + d_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 2011/09/19, 2009/01/25, 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 <= 20000
		dtoi d_index, d_index
		addi d_index, d_index
		dinc d_index
	  endw

	  d_index = 20000
	  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 2010/02/10
'2010/02/09, 2010/02/06, 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
'put answer in dg_uvalue, dg_vvalue, dg_wvalue
    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
    $ift s_any = "U=": d_process = 1 
    $ift s_any = "V=": d_process = 1
    $ift s_any = "W=": d_process = 1

    dwhi d_process = 1
        'x is in dg_xvalue, y is in dg_yvalue, z in dg_zvalue
        'u is in dg_uvalue, v is in dg_vvalue, w in dg_wvalue

	  'remove commas and blanks and pipes
	  $swp s_line, ",", sg_nothing
	  $swp s_line, " ", sg_nothing
	  $swp s_line, "|", sg_nothing

	  '| pipe 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

	  'semi-colon is the end of line operator
        $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
		        $ift s_term = "U"
			      d_number = dg_uvalue
			      d_good = 1
		        endi
		        $ift s_term = "V"
			      d_number = dg_vvalue
			      d_good = 1
		        endi
		        $ift s_term = "W"
			      d_number = dg_wvalue
			      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 = "/"
				dift d_number = 0
				    $out "zero divide"
				    d_error = 1
				else
				    d_answer = d_answer / d_number
				endi
			  endi
		        $ift s_operator = "\"
				dift d_number = 0
				    $out "zero divide"
				    d_error = 1
				else
				    d_answer = d_answer \ d_number
				endi
			  endi
		        $ift s_operator = "^"
				dpow d_answer, d_answer, d_number
			  endi
		        $ift s_operator = "%"
				'mod
				dift d_number = 0
				    $out "zero divide"
				    d_error = 1
				else
				    d_answer = d_answer % d_number
				endi
			  endi
		        $ift s_operator = "@"
				'round to d_number places
				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
		'put value in x,y,z
		$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
		$ift s_any = "U": dg_uvalue = d_answer
		$ift s_any = "V": dg_vvalue = d_answer
		$ift s_any = "W": dg_wvalue = 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_any, dg_yvalue
		        dift d_any = 1: $app s_out, ":P"
		    endi
		endi

		ded$ s_any, dg_zvalue, 0, 0
		$app s_out, ", z=" + s_any
		dift dg_zvalue > 1
		    d_any = dg_zvalue \ 1
		    dift dg_zvalue = d_any
		        dfac d_any, dg_zvalue
		        dift d_any = 1: $app s_out, ":P"
		    endi
		endi
		$out s_out

		ded$ s_any, dg_uvalue, 0, 0
		s_out = "u=" + s_any
		dift dg_uvalue > 1
		    d_any = dg_uvalue \ 1
		    dift dg_uvalue = d_any
		        dfac d_any, dg_uvalue
		        dift d_any = 1: $app s_out, ":P"
		    endi
		endi

		ded$ s_any, dg_vvalue, 0, 0
		$app s_out, ", v=" + s_any
		dift dg_vvalue > 1
		    d_any = dg_vvalue \ 1
		    dift dg_vvalue = d_any
		        dfac d_any, dg_vvalue
		        dift d_any = 1: $app s_out, ":P"
		    endi
		endi

		ded$ s_any, dg_wvalue, 0, 0
		$app s_out, ", w=" + s_any
		dift dg_wvalue > 1
		    d_any = dg_wvalue \ 1
		    dift dg_wvalue = d_any
		        dfac d_any, dg_wvalue
		        dift d_any = 1: $app s_out, ":P"
		    endi
		endi

		$out s_out
		$out s_dashes

		'pipe delimited into sg_xyzmath
		'$app sg_xyzmath, s_out + "|"

		$inp s_line, "s=show past xyz commands"

		$tup s_line, s_line

		'do we have x=, or y=
		d_process = 2
		$cut s_any, s_line, 1, 2
		$ift s_any = "X=": d_process = 1 
		$ift s_any = "Y=": d_process = 1
		$ift s_any = "Z=": d_process = 1
		$ift s_any = "U=": d_process = 1 
		$ift s_any = "V=": d_process = 1
		$ift s_any = "W=": d_process = 1

		$ift s_any = "S"
		    'list from sg_xyzmath | pipe delimited
		    $ch$ s_aster, "*", 60
		    s_line = "X=X"

		    $out s_aster
		    d_dot = 1
		    d_loop = 1
		    dwhi d_loop = 1
			  $par s_dot, sg_xyzmath, "|", d_dot
			  $trb s_dot, s_dot
			  $ift s_dot = sg_nothing
				dinc d_loop
			  else
				$out s_dot
				dinc d_dot
			  endi
		    endw
		    $out s_aster
		    d_process = 1
		endi
	  endi
	  s_command = "none"
    endw
    sg_pass1 = s_command
ends sub_xyz_math


subr sub_floating_point_accuracy
'updated 2005/03/31, 2005/03/29
    vari d_any, s_any, d_dot, s_dot
    vari d_loop, d_number, s_number, s_hold
    vari d_high, d_delta, d_random, d_totrandom
    vari d_count, d_jump

    $sys s_any, 2
    $out s_any

    d_totrandom = 0
    d_count = 0
    dpow d_jump, 10, 5
    dpow d_high, 10, 16
    dpow d_delta, 10, 13

    d_loop = 1
    dwhi d_loop = 1
	  dran d_random
	  d_totrandom = d_totrandom + d_random

	  d_number = d_high - d_delta * d_random + d_high - d_delta
	  ddec d_delta

	  d_any = d_number + 1
	  dift d_any = d_number
		dift d_number < d_high: d_high = d_number
	  endi

	  dinc d_count
	  d_any = d_count % d_jump

        dift d_any = 0
		d_any = d_totrandom / d_count

		ded$ s_any, d_count, 0, 0
		ded$ s_dot, d_high, 0, 0

		s_any = s_any + ". " + s_dot
		$app s_any, ", averan=" + d_any
		$app s_any, ", random=" + d_random
		$out s_any
	  endi
    endw
ends sub_floating_point_accuracy


subr sub_path_prog_memory
'updated 2011/09/26, 2010/11/29, 2010/09/21
'2010/05/31, 2010/05/28, 2007/12/22, 2007/12/01, 2007/11/12
'2006/09/25, 2006/09/04, 2006/08/29, 2006/04/23, 2005/10/08
    vari s_any, d_any, d_dot, s_dot, s_out, s_dashline, s_date

    $ch$ s_dashline, "-", 70
    $out s_dashline

    'path
    $sys sg_path, 1
    $trb sg_path, sg_path
   
    'lines
    dsys d_any, 2
    ded$ sg_lines, d_any, 0, 0

    'path and lines
    $out sg_path + " " + sg_lines


    'get teapro interpreter
    $sys sg_interpreter, 3
    $trb sg_interpreter, sg_interpreter

    'get load program
    $sys sg_loadprog, 4

    'memory
    dsys d_any, 1
    ded$ sg_memory, d_any, 0, 0

    'interpreter and memory
    $out sg_interpreter + " " + sg_loadprog + " " + sg_memory

    'ag_build come from top of this program
    'teapro program build and program line count
    $out sg_build + " " + sg_loadprog

    $dat s_date
    $cut s_date, s_date, 1, 20

    $out s_date

    $out s_dashline
ends sub_path_prog_memory


subr sub_prime_test_simple
'updated 2006/08/27, 2006/08/26, 2006/08/04, 2005/02/14, 2005/02/13
'2005/02/09, 2005/02/06, 2005/01/30, 2004/11/27, 2003/04/11
'simple test dg_pass1 for prime, if prime set dg_pass1 to 1
'otherwise set dg_pass1 to the divisor
'return number of tealines in dg_pass2
    vari d_any, s_any, d_dot, s_dot
    vari d_number, d_try, d_root, d_mod
    vari d_loop, d_result

    'make positive whole number 
    d_number = dg_pass1 \ 1
    dabs d_number, d_number

    'get root of
    d_any = 1 / 2
    dpow d_root, d_number, d_any

    d_result = 1

    dift d_number > 3
        'first try 2
        d_mod = d_number % 2
        dift d_mod = 0: d_result = 2
    endi

    d_try = 3
    d_loop = d_result
    dift d_try > d_root: dinc d_loop

    dwhi d_loop = 1
	  'test d_try
	  d_mod = d_number % d_try

	  dift d_mod = 0
	      'd_number is not prime
	      dinc d_loop
	      d_result = d_try
	  else
	      d_try = d_try + 2
	      dift d_try > d_root: dinc d_loop
	  endi		
    endw

    dg_pass1 = d_result
ends sub_prime_test_simple

subr sub_test_speed_of_dift
'updated 2009/04/04, 2009/04/03, 2009/04/02
    vari d_any, s_any, d_dot, s_dot
    vari d_total, d_count
    vari d_sec1, d_sec2, d_mod1
    vari d_lines1, d_lines2

    dsys d_lines1, 2
    d_total = 1000 * 1000
    d_count = 0
    dsec d_sec1

    dwhi d_count < d_total
	  d_mod1 = 0

	  dwhi d_mod1 < 39
		dift d_mod1 < 9
		    dift d_mod1 < 3
                    dift d_mod1 <> 1: goto tag_nextnumber3
		    else
			  dift d_mod1 > 5
                        dift d_mod1 <> 7: goto tag_nextnumber3
			  endi
		    endi
		else
		    dift d_mod1 < 30
			  dift d_mod1 < 21
				dift d_mod1 > 17
                            dift d_mod1 <> 19: goto tag_nextnumber3
				endi
			  endi
		    else
			  dift d_mod1 < 33
                        dift d_mod1 <> 31: goto tag_nextnumber3
			  else
				dift d_mod1 > 35
                            dift d_mod1 <> 37: goto tag_nextnumber3
				endi
			  endi
		    endi
		endi

	      gtag tag_nextnumber3

		dinc d_mod1
	  endw
	  dinc d_count
    endw

    dsec d_sec2
    d_any = d_sec2 - d_sec1
    dsys d_lines2, 2
    d_dot = d_lines2 - d_lines1
    ded$ s_dot, d_dot, 0, 0 
    $out "time3=" + d_any + " lines=" + s_dot

    dsys d_lines1, 2
    d_total = 1000 * 1000
    d_count = 0
    dsec d_sec1

    dwhi d_count < d_total
	  d_mod1 = 0

	  dwhi d_mod1 < 39
		dift d_mod1 < 9
		    dift d_mod1 < 3
                    dift d_mod1 = 0: goto tag_nextnumber4
                    dift d_mod1 = 2: goto tag_nextnumber4
		    else
			  dift d_mod1 > 5
                        dift d_mod1 = 6: goto tag_nextnumber4
                        dift d_mod1 = 8: goto tag_nextnumber4
			  endi
		    endi
		else
		    dift d_mod1 < 30
			  dift d_mod1 < 21
				dift d_mod1 > 17
                            dift d_mod1 = 18: goto tag_nextnumber4
                            dift d_mod1 = 20: goto tag_nextnumber4
				endi
			  endi
		    else
			  dift d_mod1 < 33
                        dift d_mod1 = 30: goto tag_nextnumber4
                        dift d_mod1 = 32: goto tag_nextnumber4
			  else
				dift d_mod1 > 35
                            dift d_mod1 = 36: goto tag_nextnumber4
                            dift d_mod1 = 38: goto tag_nextnumber4
				endi
			  endi
		    endi
		endi

	      gtag tag_nextnumber4

		dinc d_mod1
	  endw
	  dinc d_count
    endw

    dsec d_sec2
    d_any = d_sec2 - d_sec1
    dsys d_lines2, 2
    d_dot = d_lines2 - d_lines1
    ded$ s_dot, d_dot, 0, 0 
    $out "time4=" + d_any + " lines=" + s_dot

    dsys d_lines1, 2
    d_total = 1000 * 1000
    d_count = 0
    dsec d_sec1

    dwhi d_count < d_total
	  d_mod1 = 0

	  dwhi d_mod1 < 39
		dift d_mod1 < 9
		    dift d_mod1 < 3
                    dift d_mod1 = 0: goto tag_nextnumber5
                    dift d_mod1 = 2: goto tag_nextnumber5
		    else
                    dift d_mod1 = 6: goto tag_nextnumber5
                    dift d_mod1 = 8: goto tag_nextnumber5
		    endi
		else
		    dift d_mod1 < 21
                    dift d_mod1 = 18: goto tag_nextnumber5
                    dift d_mod1 = 20: goto tag_nextnumber5
		    else
			  dift d_mod1 < 33
                        dift d_mod1 = 30: goto tag_nextnumber5
                        dift d_mod1 = 32: goto tag_nextnumber5
			  else
                        dift d_mod1 = 36: goto tag_nextnumber5
                        dift d_mod1 = 38: goto tag_nextnumber5
			  endi
		    endi
		endi

	      gtag tag_nextnumber5

		dinc d_mod1
	  endw
	  dinc d_count
    endw

    dsec d_sec2
    d_any = d_sec2 - d_sec1
    dsys d_lines2, 2
    d_dot = d_lines2 - d_lines1
    ded$ s_dot, d_dot, 0, 0 
    $out "time5=" + d_any + " lines=" + s_dot

    dsys d_lines1, 2
    d_total = 1000 * 1000
    d_count = 0
    dsec d_sec1

    dwhi d_count < d_total
	  d_mod1 = 0

	  dwhi d_mod1 < 39
		dift d_mod1 < 9
                dift d_mod1 = 0: goto tag_nextnumber6
                dift d_mod1 = 2: goto tag_nextnumber6
                dift d_mod1 = 6: goto tag_nextnumber6
                dift d_mod1 = 8: goto tag_nextnumber6
		else
		    dift d_mod1 < 21
                    dift d_mod1 = 18: goto tag_nextnumber6
                    dift d_mod1 = 20: goto tag_nextnumber6
		    else
			  dift d_mod1 < 33
                        dift d_mod1 = 30: goto tag_nextnumber6
                        dift d_mod1 = 32: goto tag_nextnumber6
			  else
                        dift d_mod1 = 36: goto tag_nextnumber6
                        dift d_mod1 = 38: goto tag_nextnumber6
			  endi
		    endi
		endi

	      gtag tag_nextnumber6

		dinc d_mod1
	  endw
	  dinc d_count
    endw

    dsec d_sec2
    d_any = d_sec2 - d_sec1
    dsys d_lines2, 2
    d_dot = d_lines2 - d_lines1
    ded$ s_dot, d_dot, 0, 0 
    $out "time6=" + d_any + " lines=" + s_dot

    dsys d_lines1, 2
    d_total = 1000 * 1000
    d_count = 0
    dsec d_sec1

    dwhi d_count < d_total
	  d_mod1 = 0

	  dwhi d_mod1 < 39
		dift d_mod1 < 9
                dift d_mod1 = 0: goto tag_nextnumber7
                dift d_mod1 = 2: goto tag_nextnumber7
                dift d_mod1 = 6: goto tag_nextnumber7
                dift d_mod1 = 8: goto tag_nextnumber7
		else
		    dift d_mod1 < 21
                    dift d_mod1 = 18: goto tag_nextnumber7
                    dift d_mod1 = 20: goto tag_nextnumber7
		    else
                    dift d_mod1 = 30: goto tag_nextnumber7
                    dift d_mod1 = 32: goto tag_nextnumber7
                    dift d_mod1 = 36: goto tag_nextnumber7
                    dift d_mod1 = 38: goto tag_nextnumber7
		    endi
		endi

	      gtag tag_nextnumber7

		dinc d_mod1
	  endw
	  dinc d_count
    endw

    dsec d_sec2
    d_any = d_sec2 - d_sec1
    dsys d_lines2, 2
    d_dot = d_lines2 - d_lines1
    ded$ s_dot, d_dot, 0, 0 
    $out "time7=" + d_any + " lines=" + s_dot

    dsys d_lines1, 2
    d_total = 1000 * 1000
    d_count = 0
    dsec d_sec1

    dwhi d_count < d_total
	  d_mod1 = 0

	  dwhi d_mod1 < 39
		dift d_mod1 < 19
                dift d_mod1 = 0: goto tag_nextnumber8
                dift d_mod1 = 2: goto tag_nextnumber8
                dift d_mod1 = 6: goto tag_nextnumber8
                dift d_mod1 = 8: goto tag_nextnumber8
                dift d_mod1 = 18: goto tag_nextnumber8
		else
                dift d_mod1 = 20: goto tag_nextnumber8
                dift d_mod1 = 30: goto tag_nextnumber8
                dift d_mod1 = 32: goto tag_nextnumber8
                dift d_mod1 = 36: goto tag_nextnumber8
                dift d_mod1 = 38: goto tag_nextnumber8
		endi

	      gtag tag_nextnumber8

		dinc d_mod1
	  endw
	  dinc d_count
    endw

    dsec d_sec2
    d_any = d_sec2 - d_sec1
    dsys d_lines2, 2
    d_dot = d_lines2 - d_lines1
    ded$ s_dot, d_dot, 0, 0 
    $out "time8=" + d_any + " lines=" + s_dot

    dsys d_lines1, 2
    d_total = 1000 * 1000
    d_count = 0
    dsec d_sec1

    dwhi d_count < d_total
	  d_mod1 = 0

	  dwhi d_mod1 < 39
            dift d_mod1 = 0: goto tag_nextnumber9
            dift d_mod1 = 2: goto tag_nextnumber9
            dift d_mod1 = 6: goto tag_nextnumber9
            dift d_mod1 = 8: goto tag_nextnumber9
            dift d_mod1 = 18: goto tag_nextnumber9
            dift d_mod1 = 20: goto tag_nextnumber9
            dift d_mod1 = 30: goto tag_nextnumber9
            dift d_mod1 = 32: goto tag_nextnumber9
            dift d_mod1 = 36: goto tag_nextnumber9
            dift d_mod1 = 38: goto tag_nextnumber9

	      gtag tag_nextnumber9

		dinc d_mod1
	  endw
	  dinc d_count
    endw

    dsec d_sec2
    d_any = d_sec2 - d_sec1
    dsys d_lines2, 2
    d_dot = d_lines2 - d_lines1
    ded$ s_dot, d_dot, 0, 0 
    $out "time9=" + d_any + " lines=" + s_dot

    $inp s_any, "return"
ends sub_test_speed_of_dift


subr sub_test_speed_of_some_code
'updated 2011/02/20, 2011/01/31, 2011/01/07
    vari d_any, s_any, d_dot, s_dot, d_tap, s_tap
    vari d_total, d_count
    vari d_sec1, d_sec2, d_mod1
    vari d_lines1, d_lines2

    $dat s_any
    $out s_any

$out "speed test code below"
    $out "$cut s_any, s_tap, 90000, 8"
    $out "$tod d_any, s_any"
$out "speed test code above"

    d_total = 10 ^ 7
    ded$ s_any, d_total, 0, 0
    $out "now looping=" + s_any
    dsys d_lines1, 2
    d_count = 0

    d_any = 10 ^ 6
    $ch$ s_tap, "3", d_any
    dsec d_sec1

dwhi d_count < d_total

'speed test code below
    $cut s_any, s_tap, 90000, 8
    $tod d_any, s_any
'speed test code above

    dinc d_count
endw

    dsec d_sec2
    d_any = d_sec2 - d_sec1
    dsys d_lines2, 2
    d_dot = d_lines2 - d_lines1
    ded$ s_dot, d_dot, 0, 0 
    $out "time3=" + d_any + " lines=" + s_dot

    $dat s_any
    $inp s_any, "done " + s_any
ends sub_test_speed_of_some_code


subr sub_speedquick
'updated 2010/10/14, 2010/09/27
'2010/08/02, 2010/07/08, 2010/04/29, 2010/04/16, 2010/02/04
'2009/11/10, 2009/11/08, 2009/10/19, 2009/10/18, 2008/02/23
    vari d_any, s_any, d_dot, s_dot
    vari d_time, d_total, d_lines

    'count of the loop
    d_total = 10 ^ 6 * 5

    dsys d_lines, 2
    dsec d_time

    d_any = 0
    gtag tag_speedquick
	  dinc d_any
    dift d_any < d_total: goto tag_speedquick

    dsec d_any
    dsys d_dot, 2

    d_time = d_any - d_time
    dift d_time <= 0: d_time = 1
    d_lines = d_dot - d_lines

    d_any = d_lines / d_time / 1000 / 1000 
    ded$ s_any, d_any, 2, 3

    $dat s_dot
    $cut s_dot, s_dot, 1, 20
    sg_pass1 = "meg_lines/sec= " + s_any + " " + " " + s_dot
ends sub_speedquick


subr sub_speed98_test
'updated 2011/09/19, 2011/09/12, 2011/09/11
'2011/09/09, 2011/09/08, 2010/09/21, 2010/09/01, 2010/03/07
'2010/03/05, 2009/03/15, 2009/01/25, 2008/02/02, 2008/02/01
'2007/12/09, 2007/12/08, 2007/12/07, 2007/12/01, 2007/11/23
'2007/11/21, 2007/11/20, 2007/11/18, 2007/11/16, 2007/11/12
'2007/11/04, 2007/09/15, 2007/07/11, 2007/04/16, 2007/04/11
'2005/11/30, 2005/11/20, 2005/03/31, 2005/02/26, 2004/12/03
'speed test
    vari d_any, s_any, d_dot, s_dot, d_tap, s_tap, s_out
    vari d_time, d_maxcount, s_maxcount, d_count
    vari d_number, d_index, d_mod1
    vari s_dashline, d_tseconds
    vari d_teaquadpart, d_teaquadmult

    'get current subroutine name
    $sys s_any, 2
    $out s_any

    $ch$ s_dashline, "-", 70

    $out s_dashline
    sub_path_prog_memory

    d_tseconds = 0

    d_maxcount = 10 ^ 8 * 2
    ded$ s_maxcount, d_maxcount, 0, 0
    s_maxcount = " " + s_maxcount

    'load array with 20000 primes
    'put 20,000 primes in decimal array
    dsec d_tap
    d_number = 1
    d_index = 1
    dwhi d_index <= 20000
        'get the lowest factor
	  dfac d_mod1, d_number
	  dift d_mod1 = 1
	      'we have a prime
	      dtoi d_index, d_number
            dinc d_index
	  endi
	  d_number = d_number + 2
    endw

    'the first prime is 2
    dtoi 1, 2
    itod d_any, 20000
    s_out = "prime array from=2 to=" + d_any

    $app s_out, " ct=20000"
    dsec d_any
    d_tap = d_any - d_tap
    $out s_out + " sec=" + d_tap
    d_tseconds = d_tseconds + d_tap
 
'dwhi dinc loop
    $out s_dashline
    d_count = 0
    dsec d_time

    dwhi d_count < d_maxcount
	  dinc d_count
    endw

    dsec d_any
    d_time = d_any - d_time
    d_tseconds = d_tseconds + d_time
    $out "1.seconds=" + d_time + " dwhi dinc loop" + s_maxcount

'dwhi ddec loop
    $out s_dashline
    d_count = d_maxcount
    dsec d_time

    dwhi d_count > 0
	  ddec d_count
    endw

    dsec d_any
    d_time = d_any - d_time
    d_tseconds = d_tseconds + d_time
    $out "2.seconds=" + d_time + " dwhi ddec loop" + s_maxcount

'dwhi +1 loop
    $out s_dashline
    d_count = 0
    dsec d_time

    dwhi d_count < d_maxcount
	  d_count = d_count + 1
    endw

    dsec d_any
    d_time = d_any - d_time
    d_tseconds = d_tseconds + d_time
    $out "3.seconds=" + d_time + " dwhi +1 loop" + s_maxcount 

'gtag dinc loop
    $out s_dashline
    d_count = 0
    dsec d_time

    gtag tag_gtagdinc
	  dinc d_count
    dift d_count < d_maxcount: goto tag_gtagdinc

    dsec d_any
    d_time = d_any - d_time
    d_tseconds = d_tseconds + d_time
    $out "4.seconds=" + d_time + " gtag dinc dift loop" + s_maxcount

'dwhi dinc itod
    $out s_dashline
    dsec d_time

    d_dot = 10 ^ 7 * 4

    d_count = 0
    d_index = 1
    dwhi d_count < d_dot
        itod d_any, d_index
	  dinc d_index
	  dift d_index > 20000: d_index = 1

        dinc d_count
    endw

    dsec d_any
    d_time = d_any - d_time
    d_tseconds = d_tseconds + d_time
    ded$ s_dot, d_dot, 0, 0
    $out "5.seconds=" + d_time + " dwhi dinc itod " + s_dot 
    $out "total=" + d_tseconds

'dduo
    $out s_dashline
    '10,999,970,611,232,206,361
    d_teaquadmult = 10999
    s_dot = "10,999,970,611,232,206,361"
    $out s_dot
    $off s_dot, s_dot, 19
    $tod d_teaquadpart, s_dot

    dsec d_time

    dduo d_any, d_teaquadpart, d_teaquadmult

    $out "factor=" + d_any

    dsec d_any

    d_time = d_any - d_time
    d_tseconds = d_tseconds + d_time
    $out "6.seconds=" + d_time + " dduo" 

    $out s_dashline
    $inp s_any, "tot secs=" + d_tseconds
ends sub_speed98_test


subr sub_speed_test
'updated 2008/02/02, 2008/01/25, 2007/12/22, 2007/12/14
'2007/12/09, 2007/12/08, 2007/12/07, 2007/12/01, 2007/11/23
'2007/11/21, 2007/11/20, 2007/11/18, 2007/11/16, 2007/11/12
'2007/11/04, 2007/09/15, 2007/07/11, 2007/04/16, 2007/04/11
'2005/11/30, 2005/11/20, 2005/03/31, 2005/02/26, 2004/12/03
'speed test
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_count, d_maxcount, d_index, d_time1, d_time2  
    vari s_dashline, d_tseconds
    vari d_teaquadpart, d_teaquadmult

    'get current subroutine name
    $sys s_any, 2
    $out s_any

    $ch$ s_dashline, "-", 70

    $out s_dashline
    sub_path_prog_memory

    d_tseconds = 0

    d_maxcount = 10 ^ 6 * 100

'dwhi dinc loop
    $out s_dashline
    d_count = 0
    dsec d_time1

    dwhi d_count < d_maxcount
	  dinc d_count
    endw

    dsec d_any
    d_time1 = d_any - d_time1
    d_tseconds = d_tseconds + d_time1
    ded$ s_any, d_maxcount, 0, 0
    $out s_any + " dinc loop, seconds=" + d_time1

'dwhi +1 loop
    $out s_dashline
    d_count = 0
    dsec d_time2

    dwhi d_count < d_maxcount
	  d_count = d_count + 1
    endw

    dsec d_any
    d_time2 = d_any - d_time2
    d_tseconds = d_tseconds + d_time2
    ded$ s_any, d_maxcount, 0, 0
    $out s_any + "   +1 loop, seconds=" + d_time2

    $out s_dashline
    $out "total time=" + d_tseconds
    $out s_dashline

    sub_path_prog_memory

    $out s_dashline
    $inp s_any, "done"
ends sub_speed_test
'tinytea.tea is a program in Teapro programming language