'begin the teatest.tea program begun on 06-SEP-2001
'written in Teapro which uses the OpenTea technology
'People need computer software that actually works.
vari dg_pass1, dg_pass2, dg_pass3, dg_pass4
vari sg_pass1, sg_pass2, sg_pass3, sg_pass4
vari dg_xvalue, dg_yvalue, dg_zvalue, sg_xyzmath
vari sg_nothing, sg_build

sub_main
endp

subr sub_main
'main subroutine
'updated 2007/09/10, 2004/04/17
    vari d_any, s_any, d_dot, s_dot
    vari d_loop, s_pick, d_pick

    $trb sg_nothing, " "

    d_loop = 1
    dwhi d_loop = 1
        s_dot = "Program: teatest.tea, build=58, 2009/10/25"
	  $cut sg_build, s_dot, 23, 8
	  $out s_dot
        $out "Copyright (c) 2001-2009 D La Pierre Ballard"
        $out "Written in Teapro which uses the OpenTea technology"
        $out "Copyright (c) 1997-2009 D La Pierre Ballard"
	  $out "People need computer software that actually works."

	  $sys s_any, 1
	  $out s_any
	  $dat s_any
	  dsec d_any
	  $out "date=" + s_any + ", seconds=" + d_any
	  $out " "

	  sub_floating_point_test
	  
	  $out "1. min for bad add one to a number"
	  $out "2. min and max for \ 1 to make an integer"
	  $out "3. non-integer numbers"
	  $out "4. sub_random_test"
	  $out "5. sub_floating_point_test"
	  $out "6. sub_test_various_commands1"
	  $out "7. sub_next_test_code"
	  $out "8. sub_word_to_number"
	  $out "9. sub_command_speed_test"
	  $out "10. file append test"
	  $out "11. sub_mod_arithmetic_test"
	  $out "96. sub_xyzmath"
	  $out "98. sub_teaquad_prime_speed_test"
	  $out "99. sub_speed_test"

	  s_dot = "pick a number *=end " + sg_build
	  $app s_dot, " x=" + dg_xvalue
	  $inp s_pick, s_dot
	  $ift s_pick = "*": dinc d_loop

	  d_pick = 0
	  $isd d_any, s_pick
	  dift d_any = 1: $tod d_pick, s_pick

        dift d_pick = 1: sub_bad_add_one_to_large_number
	  dift d_pick = 2: sub_make_an_integer
	  dift d_pick = 3: sub_non_integers
	  dift d_pick = 4: sub_random_test
	  dift d_pick = 5: sub_floating_point_test
	  dift d_pick = 6: sub_test_various_commands1
	  dift d_pick = 7: sub_next_test_code
	  dift d_pick = 8: sub_word_to_number
	  dift d_pick = 9: sub_command_speed
	  dift d_pick = 10
		$inp s_any, "1=new"
		$ift s_any = "1"
		    sub_file_append_new
		else
		    sub_file_append_old
		endi
	  endi
	  dift d_pick = 11: sub_mod_arithmetic_test
	  dift d_pick = 96
		sg_pass1 = "x=x"
		sub_xyzmath
	  endi
	  dift d_pick = 98: sub_teaquad_prime_speed_test
	  dift d_pick = 99: sub_speed_test
	  sg_pass1 = s_pick
	  sub_xyzmath
    endw
ends sub_main


subr sub_file_append_old
'updated 2004/10/21
    vari d_any, s_any, d_dot, s_dot, s_out
    vari s_file, s_number, d_count, d_loop, d_bytes

    s_file = "zappend.txt"
    dran d_any
    d_any = 1000 * 100 * d_any
    dto$ s_number, d_any, 0, 0
    d_count = 0

    d_loop = 1
    dwhi d_loop = 1
	  dinc d_count

	  s_out = d_count + ".  " + s_number

	  fapp d_bytes, s_file, s_out
	  dbad d_bytes = 0

	  d_dot = 0

	  dwhi d_bytes = 0

		dinc d_dot

		s_any = s_out + " extra " + d_dot

		
		fapp d_bytes, s_file, s_any
		dbad d_bytes = 0
	 
		
	  endw
    endw
ends sub_file_append_old


subr sub_file_append_new
'updated 2003/05/05
    vari d_any, s_any, d_dot, s_dot, s_out
    vari s_file, s_number, d_count, d_loop, d_bytes

    s_file = "zappend.txt"
    dran d_any
    d_any = 1000 * d_any
    dto$ s_number, d_any, 0, 0
    d_count = 0

    d_loop = 1
    dwhi d_loop = 1
	  
	  dinc d_count

 	  
	  s_out = d_count + ".  " + s_number

	  
	  fapp d_bytes, s_file, s_out
	  dift d_bytes = 0: $out s_out
	  
    endw
ends sub_file_append_new


subr sub_command_speed
'updated 2003/03/11
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_sec0, d_sec1, d_sec2, d_count, d_total

    d_count = 0
    dpow d_total, 10, 6
    dsec d_sec1
    dwhi d_count < d_total
	  dinc d_count
    endw
    dsec d_sec2
    d_sec0 = d_sec2 - d_sec1

    d_count = 0
    dsec d_sec1
    dwhi d_count < d_total
	  s_any = "hello"
	  dinc d_count
    endw
    dsec d_sec2

    d_any = d_sec2 - d_sec1 - d_sec0

    $out "P2.26, d_dot=d_dot+1, 1.15sec"
    $out "P2.26, , 0.281sec"
    $out "P2.26, s_dot='hello', 1.27sec"

    $out "seconds=" + d_any
    $inp s_any, "return"
ends sub_command_speed


subr sub_word_to_number
'updated 2002/08/02
    vari d_any, s_any, d_dot, s_dot, s_out
    vari s_alpha, d_loop, d_number1, d_number2
    vari d_big1, d_big2, d_small, d_method
    vari d_long, d_byte, s_word

    d_method = 1
    $inp s_any, "which method 1,2"
    $isd d_any, s_any
    dift d_any = 1: $tod d_method, s_any

    s_alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"
    $tod d_big1, "700000001"
    $tod d_big2, "612345857"
    $tod d_any, "2147483647"
    d_small = d_any \ 36 - 1
    ded$ s_any, d_small, 0, 0
    $out "d_small=" + s_any
 
    d_loop = 1
    dwhi d_loop = 1
	  $inp s_word, "enter a word, * to end"
	  $ift s_word = "*": dinc d_loop

	  $cup s_word, s_word
	  $trb s_word, s_word
	  $cut s_word, s_word, 1, 12
	  $len d_long, s_word

	  d_number1 = 0
	  d_number2 = 0

	  d_byte = 1
	  dift d_loop <> 1: d_byte = 99999

	  dwhi d_byte <= d_long
	      $cut s_dot, s_word, d_byte, 1
	      $lok d_dot, s_alpha, 1, s_dot

		dift d_method = 1
		    d_any = d_dot * d_dot * d_byte
                d_number1 = d_number1 * 3 + d_any % d_big1
		    d_any = d_dot * d_dot * d_dot
                d_number2 = d_number2 * 3 + d_any % d_big2
		endi
		dift d_method = 2
		    d_any = d_long \ 2
		    dift d_byte <= d_any
			  d_number1 = d_number1 % d_small
		        d_number1 = d_number1 * 36 + d_dot % d_big1
		    else
			  d_number2 = d_number2 % d_small
		        d_number2 = d_number2 * 36 + d_dot % d_big2
		    endi
		endi
		ded$ s_any, d_number1, 15, 0
		s_out = s_dot + "1=" + s_any 
		ded$ s_any, d_number2, 15, 0
		$app s_out, ", 2=" + s_any
		$out s_out

	      dinc d_byte
	  endw

	  $out "method=" + d_method
	  $out "word=" + s_word

	  ded$ s_any, d_number1, 15, 0
	  $out "number1=" + s_any

	  ded$ s_any, d_number2, 15, 0
	  $out "number2=" + s_any
    endw
ends sub_word_to_number


subr sub_next_test_code
'updated 2002/07/28
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_big1, d_number1, d_divisor1
    vari d_big2, d_number2, d_divisor2
    vari d_maxcount, d_count, d_diff, d_holdprevious
    vari d_index, d_value, d_shift, d_previous, d_kicker

    'best 50,19,23,100000=61

    d_holdprevious = 50
    $inp s_any, "1 through 95 shift to look at next"
    $isd d_any, s_any
    dift d_any = 1: $tod d_holdprevious, s_any

    d_divisor1 = 19
    $inp s_any, "1 through 10000 first divisor, 19"
    $isd d_any, s_any
    dift d_any = 1: $tod d_divisor1, s_any

    d_divisor2 = 23
    $inp s_any, "1 through 10000 second divisor, 23"
    $isd d_any, s_any
    dift d_any = 1: $tod d_divisor2, s_any

    dpow d_maxcount, 10, 5
    $inp s_any, "how many? 100000"
    $isd d_any, s_any
    dift d_any = 1: $tod d_maxcount, s_any

    'initialize array
    d_index = 1
    dwhi d_index <= 200
	  dtoi d_index, 0
	  dinc d_index
    endw

    d_previous = 0
    $tod d_big1, "700000001"
    $tod d_big2, "612345857"
    dran d_number1
    d_any = d_number1 * 99999
    dpow d_any, d_any, 3
    d_number1 = d_any % d_big1

    dran d_number2
    d_any = d_number2 * 99999
    dpow d_any, d_any, 3
    d_number2 = d_any % d_big2

    d_kicker = 0
    d_count = 0

    dwhi d_count <= d_maxcount
	  dinc d_kicker
	  dift d_kicker > 100: d_kicker = 1

	  d_number1 = d_number1 * 3 + 17 % d_big1
	  d_shift = d_number1 \ d_divisor1 % 95 + 1

	  d_number2 = d_number2 * 3 + 19 % d_big2
	  d_any = d_number2 \ d_divisor2 % 95 + 1
	  d_shift = d_shift + d_any + d_kicker % 95 + 1

	  'add to array element
	  dift d_previous = d_holdprevious
	      d_diff = d_shift - d_previous + 95 % 95 + 1

		itod d_any, d_diff
		dinc d_any
		dtoi d_diff, d_any
	  endi

	  d_previous = d_shift

	  dinc d_count
    endw

    'output counts in array four per line
    d_count = 0
    $ch$ s_out, " ", 80
    d_index = 1

    dwhi d_index <= 95
	  itod d_value, d_index

	  'only if we have some
	  dift d_value > 0
		dinc d_count

	      d_dot = d_count - 1 % 5 * 16 + 1
	      s_dot = d_index + "=" + d_value
	      $rep s_out, d_dot, s_dot

		'output when we have four	  
	      d_dot = d_count % 5
	      dift d_dot = 0
		    $out s_out
		    $ch$ s_out, " ", 80
	      endi
	  endi

	  dinc d_index
    endw
    $out s_out
    $out "total good=" + d_count

    $inp s_any, "return"    
ends sub_next_test_code


subr sub_bad_add_one_to_large_number
'updated 2004/10/18
    vari d_any, s_any, d_dot, s_dot
    vari d_loop, d_random, d_tell, s_tell, d_10quadrillion
    vari d_number1, d_number2, d_new1, d_new2, d_new3, d_new4
    vari d_badminimum, d_badcount
    vari d_nummin, d_nummax, d_showminmax
    vari s_string1, s_string2
    vari d_holdmin, d_holdmax, d_numstring
    vari d_process, d_goodnumber, d_newnumber, d_holdnumber
    vari d_badmininteger, d_badminstring
    vari d_holdbadmininteger, d_holdbadminstring

    dpow d_10quadrillion, 10, 16

    d_process = 1
    $inp s_any, "1=find bad add by repeatedly adding one"
    $ift s_any = "1"
	  d_numstring = 2
	  $inp s_any, "1=compare numbers by string"
 	  $ift s_any = "1": d_numstring = 1

	  '$out "last good=9,007,199,254,740,991"
	  $out "last good=5,764,607,523,034,236 for strings"
	  $tod d_number1, "5,764,607,520,000,000"
	  ded$ s_any, d_number1, 0, 0
	  $out "default good start number=" + s_any
	  $out "enter start number"
	  $inp s_any, "123456789012345678901"
	  $ift s_any = "*": dinc d_process
	  $isd d_any, s_any
	  dift d_any = 1: $tod d_number1, s_any
   
	  d_loop = d_process
	  dwhi d_loop = 1
		d_holdnumber = d_number1
		d_newnumber = d_number1 + 1
		dift d_numstring = 1
		    'last good one is 5,764,607,523,034,236 on 2004/10/14
		    dto$ s_string1, d_newnumber, 0, 0
		    dto$ s_string2, d_number1, 0, 0
		    $ift s_string1 = s_string2
		        s_any = "adding one to ensuing numbers "
		        $app s_any, "may not change their strings"
		        ded$ s_any, d_goodnumber, 0, 0
		        $out "last good number=" + s_any
		        $inp s_any, "return"
		        dinc d_loop
		        dinc d_process
		    endi
		else
		    dift d_newnumber = d_number1
		        s_any = "adding one to ensuing numbers "
		        $app s_any, "may not change them"
		        ded$ s_any, d_goodnumber, 0, 0
		        $out "last good number=" + s_any
		        $inp s_any, "return"
		        dinc d_loop
		        dinc d_process
		    endi
		endi
		dift d_process = 1
		    d_any = 1000 * 100
		    d_any = d_number1 % d_any
		    dift d_any = 0
			  ded$ s_any, d_number1, 0, 0
			  $sho s_any
		    endi

		    d_goodnumber = d_number1
		    dinc d_number1
		endi
	  endw
    endi

    dift d_process = 1
	  d_showminmax = 2
	  $inp s_any, "1=show min max numbers"
	  $ift s_any = "1": d_showminmax = 1
    endi

    'find min number where adding one no longer works
    d_nummin = d_10quadrillion
    d_nummax = 0
    dpow d_badmininteger, 10, 16
    dpow d_badminstring, 10, 16

    $out "bad integer min=9,007,199,254,740,991"
    $out "bad string min= 5,764,607,523,034,236"
    d_tell = 0
    d_badcount = 0
    d_loop = d_process

    dwhi d_loop = 1
	  dinc d_tell
	  d_any = 1000 * 100
	  d_any = d_tell % d_any
	  dift d_any = 0
	      ded$ s_tell, d_tell, 0, 0

	      dift d_badmininteger <> d_holdbadmininteger
	          d_holdbadmininteger = d_badmininteger

	          ded$ s_dot, d_badmininteger, 0, 0
	          s_any = "badmininteger=" + s_dot 

	          $app s_any, ", tell=" + s_tell
	          $out s_any
		endi
	      dift d_badminstring <> d_holdbadminstring
	          d_holdbadminstring = d_badminstring

	          ded$ s_dot, d_badminstring, 0, 0
	          s_any = "badminstring= " + s_dot 

	          $app s_any, ", tell=" + s_tell
	          $out s_any
		endi

		dift d_showminmax = 1
		    d_any = 2
		    dift d_nummin <> d_holdmin: d_any = 1
		    dift d_nummax <> d_holdmax: d_any = 1
		    dift d_any = 1
		        d_holdmin = d_nummin
		        d_holdmax = d_nummax

		        ded$ s_any, d_nummin, 0, 0
		        s_dot = "number min=" + s_any
		        ded$ s_any, d_nummax, 0, 0
		        $app s_dot, ", max=" + s_any
		        $out s_dot
		    endi
		endi
	  endi
        $sho "tell=" + s_tell

        dran d_random
        d_number1 = d_10quadrillion * d_random \ 1

	  dift d_showminmax = 1
            dift d_number1 < d_nummin: d_nummin = d_number1
            dift d_number1 > d_nummax: d_nummax = d_number1
	  endi

        d_number2 = d_number1 + 1
	  'are strings made from the two numbers the same
	  dto$ s_string1, d_number1, 0, 0
	  dto$ s_string2, d_number2, 0, 0

	  d_dot = 2
        $ift s_string1 = s_string2: d_dot = 1

	  $tod d_new1, s_string1
	  dift d_new1 <> d_number1: d_dot = 1

	  $tod d_new2, s_string2
	  dift d_new2 <> d_number2: d_dot = 1
	  d_any = d_new2 - d_number1
	  dift d_any <> 1: d_dot = 1

	  dift d_dot = 1
            dift d_number1 < d_badminstring
		    d_badminstring = d_number1
		endi
	  endi

	  'are the two numbers the same
        dift d_number1 = d_number2
            dift d_number1 < d_badmininteger
		    d_badmininteger = d_number1
		endi
        endi
    endw
ends sub_bad_add_one


subr sub_make_an_integer
'make a large random number into an integer, then is it one
'updated 2001/09/08
    vari d_any, s_any, d_dot, s_dot
    vari d_loop, d_random, d_change, d_tell
    vari d_number, s_number, d_yesmax, d_badmin

    d_yesmax = 0
    dpow d_badmin, 10, 25

    d_tell = 0
    d_change = 2
    d_loop = 1

    dwhi d_loop = 1
	  dinc d_tell
        dinc d_change

        dran d_random
	  dpow d_any, 10, 18
	  d_number = d_any * d_random \ 1

	  s_number = d_number
	  $lok d_dot, s_number, 1, "."
	 
        dift d_dot > 0
	      dift d_number < d_badmin
		    d_badmin = d_number
		    d_change = 1
	      endi
        else
	      dift d_number > d_yesmax
		    d_yesmax = d_number
		    d_change = 1
	      endi
        endi

	  dift d_change = 1
		ded$ s_any, d_yesmax, 0, 0
		ded$ s_dot, d_badmin, 0, 0
		$out "yesmax=" + s_any + ", badmin=" + s_dot
		ded$ s_any, d_tell, 0, 0
		$out "make an integer tell=" + s_any
	  endi
    endw
ends sub_make_an_integer


subr sub_non_integers
'find non integer numbers
'updated 2001/09/09
    vari d_any, s_any, d_dot, s_dot
    vari d_loop, d_random, d_tell, d_lines
    vari d_number, s_number, d_count, d_run
    vari d_minimum, d_nummin, d_nummax

    dpow d_nummin, 10, 25
    d_nummax = 0
    dpow d_minimum, 10, 25

    d_run = 2
    d_count = 0
    d_lines = 0
    d_tell = 0
    d_loop = 1

    dwhi d_loop = 1
	  dinc d_tell
	  d_any = 1000 * 100
	  d_any = d_tell % d_any
	  dift d_any = 0
		ded$ s_dot, d_tell, 0, 0
		s_any = "non-int tell=" + s_dot

		ded$ s_dot, d_minimum, 0, 0
		$app s_any, ", min=" + s_dot

		ded$ s_dot, d_count, 0, 0
		$app s_any, ", ct=" + s_dot
		$out s_any

		ded$ s_any, d_nummin, 0, 0
		ded$ s_dot, d_nummax, 0, 0
		$out "number min=" + s_any + ", max=" + s_dot
	  endi

        dran d_random
	  dpow d_any, 10, 18
	  d_number = d_any * d_random \ 1

	  dift d_number < d_nummin: d_nummin = d_number
	  dift d_number > d_nummax: d_nummax = d_number

	  s_number = d_number
	  $lok d_dot, s_number, 1, "."
	 
        dift d_dot > 0
		dinc d_dot
		$cut s_any, s_number, d_dot, 1
		$ift s_any <> "0"
		    dift d_number < d_minimum: d_minimum = d_number
		    dinc d_count

		    dift d_run <> 1
		        dinc d_lines
		        dift d_lines > 20
			      d_lines = 0
			      $inp s_any, "return, 1=run, * to end"
			      $ift s_any = "*": dinc d_loop
			      $ift s_any = "1": d_run = 1
		        endi

		        ded$ s_number, d_number, 0, 0
		        $out d_count + ". non-integer=" + s_number
		    endi
	      endi
        endi
    endw
ends sub_non_integers


subr sub_random_test
'find non integer numbers
'updated 2001/09/09
    vari d_any, s_any, d_dot, s_dot
    vari d_loop, d_random, d_tell, d_lines
    vari d_number, s_number, d_count, d_run
    vari d_minimum, d_nummin, d_nummax

    dpow d_nummin, 10, 25
    d_nummax = 0
    dpow d_minimum, 10, 25
    d_run = 2
    d_count = 0
    d_lines = 0
    d_tell = 0
    d_loop = 1

    dwhi d_loop = 1
	  dinc d_tell
	  d_any = 1000 * 100
	  d_any = d_tell % d_any
	  dift d_any = 0
		ded$ s_dot, d_tell, 0, 0
		s_any = "non-int tell=" + s_dot

		ded$ s_dot, d_minimum, 0, 0
		$app s_any, ", min=" + s_dot

		ded$ s_dot, d_count, 0, 0
		$app s_any, ", ct=" + d_count
		$out s_any

		ded$ s_any, d_nummin, 0, 0
		ded$ s_dot, d_nummax, 0, 0
		$out "number min=" + s_any + ", max=" + s_dot
	  endi

	  dinc d_lines
	  dift d_lines > 0
		d_lines = 0
		$inp s_any, "return, * to end"
		$ift s_any = "*": dinc d_loop
	  endi

        dran d_random
	  dpow d_dot, 10, 18
	  d_dot = d_dot * d_random
	  d_number = d_dot \ 1

	  ded$ s_any, d_random, 0, 0
	  $out s_any

	  ded$ s_any, d_dot, 0, 0
	  $out s_any

	  ded$ s_any, d_number, 0, 0
	  $out s_any


	  dift d_number < d_nummin: d_nummin = d_number
	  dift d_number > d_nummax: d_nummax = d_number
    endw
ends sub_random_test

 
subr sub_floating_point_test
'updated 2004/09/25
    vari d_any, s_any, d_dot, s_dot
    vari s_out
   
    dpow d_any, 10, 15
    d_any = d_any / 3
    ded$ s_out, d_any, 0, 15

    s_out = "10E15/3=" + s_out

    s_any = "error: floating point: "
    $lok d_dot, s_out, 1, "."

    dift d_dot > 0
	  ddec d_dot
	  $cut s_dot, s_out, d_dot, 3
	  $ift s_dot = "3.3": s_any = "ok: floating point: "
    endi
    $out s_any + s_out
ends sub_floating_point_test


subr sub_test_various_commands1
'updated 2004/10/20
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_pick, d_loop

    $out "1. test $PAR, character separated variable extract"
    $out "2. test $ISP, string versus string by pattern"
    $out "3. test $OFF, string end"
    $out "4. test DROU and DTRU"
    $out "5. test ARRZ and ARRB"
    $out "6. test $SWP"
    $out "7. test $INS"
    $out "9. test $SYS"
    $out "10. test DTOF"
    $out "11. test DBAD"
    $inp s_any, "enter number"

    d_pick = 0
    $isd d_any, s_any
    dift d_any = 1: $tod d_pick, s_any

    d_loop = 1
    dwhi d_loop = 1
	  dg_pass1 = d_pick
	  sub_test_various_commands2
	  d_loop = dg_pass1
    endw
ends sub_test_various_commands1


subr sub_test_various_commands2
'updated 2005/01/19, 2004/10/20
    vari d_any, s_any, d_dot, s_dot, s_out
    vari s_parm1, s_parm2, s_parm3, s_parm4
    vari d_parm1, d_parm2, d_parm3, d_parm4
    vari d_number, d_result
    vari d_pick, s_char

    d_pick = dg_pass1

    dift d_pick = 1
	  $inp s_char, "enter a character to delimit with"
	  $inp s_dot, "enter a string delimited with the char"
	  $par s_any, s_dot, s_char, 1
	  $out "#1=" + s_any

	  $par s_any, s_dot, s_char, 2
	  $out "#2=" + s_any

	  $par s_any, s_dot, s_char, 3
	  $out "#3=" + s_any

	  $par s_any, s_dot, s_char, 4
	  $out "#4=" + s_any

	  $par s_any, s_dot, s_char, 5
	  $out "#5=" + s_any

	  $par s_any, s_dot, s_char, 6
	  $out "#6=" + s_any

	  $inp s_any, "done"
    endi
    dift d_pick = 2
	  '$isp string versus string by pattern
	  $inp s_any, "enter first string"
	  $inp s_dot, "enter second string"
	  $isp d_dot, s_any, s_dot
	  $out s_any
	  $out s_dot
	  $out "result=" + d_dot
	  $inp s_any, "done"
    endi
    dift d_pick = 3
	  '$off
	  $inp s_dot, "enter begin string"
	  $out "string='" + s_dot + "'"

	  $inp s_any, "enter length to get from end"
	  d_dot = 0
	  $isd d_any, s_any
	  dift d_any = 1: $tod d_dot, s_any   
	  $out "length=" + d_dot

	  s_any = "qwerty"
	  $off s_any, s_dot, d_dot
	  $out "begin string='" + s_dot + "'"
	  $out "end string  ='" + s_any + "'"
	  $out "length=" + d_dot
    endi
    dift d_pick = 4
	  $inp s_any, "enter a number to test DROU and DTRU"
	  $isd d_any, s_any
	  d_number = 0
	  dift d_any = 1
		$tod d_number, s_any	

	      $out "DROU d_result, d_number"
	      drou d_result, d_number
	      $out "d_result=" + d_result

	      $out "DTRU d_result, d_number"
	      dtru d_result, d_number
	      $out "d_result=" + d_result
	  else
		$out "bad number entered"
	  endi
    endi
    dift d_pick = 5
	  d_dot = 1
	  dwhi d_dot <= 2000
		s_any = "number=" + d_dot
		$toi d_dot, s_any
		dtoi d_dot, d_dot
		dinc d_dot
	  endw
	  $inp s_any, "the arrays are full"
	  arrz
	  arrb
	  $inp s_any, "the arrays are zero or blank"
    endi
    dift d_pick = 6
	  $inp s_parm1, "$swp, input string to replace in"
	  $inp s_parm2, "$swp, input string to replace"
	  $inp s_parm3, "$swp, input string to replace with"

	  $out "before"
	  $out "s_parm1=" + s_parm1
	  $out "s_parm2=" + s_parm2
	  $out "s_parm3=" + s_parm3
	  $swp s_parm1, s_parm2, s_parm3
	  $out "after"
	  $out "s_parm1=" + s_parm1
	  $out "s_parm2=" + s_parm2
	  $out "s_parm3=" + s_parm3
    endi
    dift d_pick = 7
	  $inp s_parm1, "enter string to insert into"
	  $inp s_dot, "enter byte to insert"
	  $tod d_dot, s_dot
	  $inp s_parm3, "enter string to insert"
	  $ins s_parm1, d_dot, s_parm3
	  $out s_parm1
    endi
    dift d_pick = 9
	  '$sys
	  $inp s_any, "enter parm2 for $sys"
	  $isd d_any, s_any
	  dift d_any = 1: $tod d_parm2, s_any
	  $sys s_any, d_parm2
	  $out "$sys s_any," + d_parm2
	  $out "s_any=" + s_any
    endi
    dift d_pick = 10
	  'dtof
	  $inp s_any, "enter decimal number"
	  $isd d_any, s_any
	  dift d_any = 1: $tod d_parm2, s_any
	  $inp s_any, "enter length"
	  $isd d_any, s_any
	  dift d_any = 1: $tod d_parm3, s_any
	  dtof s_parm1, d_parm2, d_parm3
	  $out "s_parm1=" + s_parm1
    endi
    dift d_pick = 11
	  $out "DBAD d_parm1 > d_parm2"

	  $inp s_any, "DBAD test, enter first number"
	  $tod d_parm1, s_any

	  $inp s_any, "DBAD test, enter second number"
	  $tod d_parm2, s_any

	  dbad d_parm1 > d_parm2
    endi

    d_any = 1
    $inp s_any, "return for more, * to end"
    $ift s_any = "*": dinc d_any
    dg_pass1 = d_any    
ends sub_test_various_commands2


subr sub_mod_arithmetic_test
'updated 2007/09/12, 2007/09/10
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_loop, d_good, d_divisor, d_result
    vari d_billpart, d_billmult, d_billone
    vari d_mod1, d_mod2, d_mod3

    d_divisor = 17
    d_billone = 10 ^ 9
    d_billpart = 1
    d_billmult = 1

    d_loop = 1
    dwhi d_loop = 1
	  d_good = 1
	  dift d_good = 1
		$inp s_any, "enter bill mult"
		$ift s_any = "*": dinc d_good
		$isd d_any, s_any
		dift d_any = 1: $tod d_billmult, s_any
	  endi
	  dift d_good = 1
		$inp s_any, "enter bill part"
		$ift s_any = "*": dinc d_good
		$isd d_any, s_any
		dift d_any = 1: $tod d_billpart, s_any
	  endi
	  dift d_good = 1
		$inp s_any, "enter mod divisor"
		$ift s_any = "*": dinc d_good
		$isd d_any, s_any
		dift d_any = 1: $tod d_divisor, s_any
	  endi
	  dift d_good = 1
		d_mod1 = d_billone % d_divisor
		d_mod2 = d_billpart % d_divisor
		d_mod3 = d_billmult % d_divisor
		d_result = d_mod1 * d_mod3 + d_mod2 % d_divisor

		$out "billone=" + d_billone
		$out "billpart=" + d_billpart
		$out "billmult=" + d_billmult
		$out "divisor=" + d_divisor

		$out "billone % divisor=" + d_mod1
		$out "billpart % divisor=" + d_mod2
		$out "billmult % divisor=" + d_mod3
		$out "result=" + d_result

		$inp s_any, "return"
		$ift s_any = "*": dinc d_good
	  endi

	  d_loop = d_good
    endw
ends sub_mod_arithmetic_test


subr sub_xyzmath
'updated 2004/1/4
'solve a multi number math expression in sg_pass1
'the format is: x=123*567+4.6 etc or y=123*567+4.6
'put answer in dg_xvalue, dg_yvalue, dg_zvalue
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_good, d_long, d_loop, d_error, d_lines
    vari s_line, d_number, s_operator, d_answer, s_xyzvalue
    vari s_work, d_byte, s_term, d_process, s_command, s_aster

    s_command = sg_pass1
    $cup s_line, s_command
    $trb s_line, s_line

    $ift s_line = "XYZ": s_line = "X=X"

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

    dwhi d_process = 1
        'x is in dg_xvalue, y is in dg_yvalue, z in dg_zvalue

	  'remove commas and blanks
	  d_loop = 1
	  dwhi d_loop = 1
		dinc d_loop

		$lok d_dot, s_line, 1, ","
		dift d_dot > 0
		    $del s_line, d_dot, 1
		    d_loop = 1
		endi

		$lok d_dot, s_line, 1, " "
		dift d_dot > 0
		    $del s_line, d_dot, 1
		    d_loop = 1
		endi
	  endw

	  'colon delimited into sg_xyzmath
	  $app sg_xyzmath, s_line + ":"

        'remove the x= or y= at the beginning
        $cut s_work, s_line, 3, 100
	  $cut s_any, s_work, 1, 1

	  'put on + if needed
	  $ift s_any <> "+"
		$ift s_any <> "-": s_work = "+" + s_work
	  endi
        $app s_work, ";"

        $len d_long, s_work
        d_error = 2
        d_byte = 2
        d_answer = 0
        d_loop = 1

        dwhi d_loop = 1
		'do we have the next operator in d_byte
	      $cut s_dot, s_work, d_byte, 1
		s_any = "+-/\^%;"
	      $lok d_any, s_any, 1, s_dot

	      dift d_any > 0
		    'we have the location of the next operator
		    d_long = d_byte - 2

		    'the current operator is in 1
		    'get the number or x or y
		    $cut s_term, s_work, 2, d_long

		    'is this string a number
		    $isd d_good, s_term
		    dift d_good = 1
		        $tod d_number, s_term
		    else
		        'if X then use the xvalue from previous
		        $ift s_term = "X"
			      d_number = dg_xvalue
			      d_good = 1
		        endi
		        $ift s_term = "Y"
			      d_number = dg_yvalue
			      d_good = 1
		        endi
		        $ift s_term = "Z"
			      d_number = dg_zvalue
			      d_good = 1
		        endi
			  dift d_good <> 1: d_error = 1
		    endi
		    dift d_good = 1
			  'get current operator
		        $cut s_operator, s_work, 1, 1
		    
		        $ift s_operator = "+"
				d_answer = d_answer + d_number
			  endi
		        $ift s_operator = "-"
				d_answer = d_answer - d_number
			  endi
		        $ift s_operator = "*"
				d_answer = d_answer * d_number
			  endi
		        $ift s_operator = "/"
				d_answer = d_answer / d_number
			  endi
		        $ift s_operator = "\"
				d_answer = d_answer \ d_number
			  endi
		        $ift s_operator = "^"
				dpow d_answer, d_answer, d_number
			  endi
		        $ift s_operator = "%"
				d_answer = d_answer % d_number
			  endi

			  'put next operator in 1
		        $cut s_work, s_work, d_byte, 99999
		        d_byte = 1
		    endi
	      endi

	      dinc d_byte

	      $len d_long, s_work
	      dift d_byte > d_long: dinc d_loop

	      dift d_error = 1: dinc d_loop

	      'we end with a semi-colon
	      $cut s_any, s_work, 1, 1
	      $ift s_any = ";": dinc d_loop
        endw

        dift d_error = 1
            s_out = "error in expression: " + s_line
		$inp s_any, s_out
		s_line = "X=X"
        else
		$cut s_any, s_line, 1, 1
		$ift s_any = "X": dg_xvalue = d_answer
		$ift s_any = "Y": dg_yvalue = d_answer
		$ift s_any = "Z": dg_zvalue = d_answer

		ded$ s_any, dg_xvalue, 0, 15
		s_out = "x=" + s_any
		ded$ s_any, dg_yvalue, 0, 15
		$app s_out, ", y=" + s_any
		ded$ s_any, dg_zvalue, 0, 15
		$app s_out, ", z=" + s_any

		'colon delimited into sg_xyzmath
		$app sg_xyzmath, s_out + ":"

		$app s_out, ", m=more"		

		$inp s_line, s_out
		$cup s_line, s_line
		$trb s_line, s_line

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

		$ift s_any = "M"
		    'print or list from sg_xyzmath colon delimited
		    $ch$ s_aster, "*", 60
		    s_line = "X=X"

		    $out s_aster
		    d_dot = 1
		    d_loop = 1
		    dwhi d_loop = 1
			  $par s_dot, sg_xyzmath, ":", d_dot
			  $trb s_dot, s_dot
			  $ift s_dot = sg_nothing
				dinc d_loop
			  else
				dinc d_lines
				dift d_lines > 40
				    d_lines = 1
				endi
				$out s_dot
				dinc d_dot
			  endi
		    endw
		    $out s_aster
		    d_process = 1
		endi
	  endi
	  s_command = "none"
    endw
    sg_pass1 = s_command
ends sub_xyzmath


subr sub_teaquad_to_string
'updated 2007/03/30, 2007/02/24, 2006/11/25, 2006/11/12, 2006/10/27
'change a teaquad number in d_teaquadpart,d_teaquadmult to a string
    vari d_any, s_any, d_dot, s_dot
    vari d_teaquadpart, d_teaquadmult, s_line
    vari s_beg, d_beg

    d_teaquadpart = dg_pass1
    d_teaquadmult = dg_pass2

    dift d_teaquadpart < 0
	  dpow d_any, 10 ,15
	  d_teaquadpart = d_teaquadpart + d_any
	  ddec d_teaquadmult	
    endi

'123456789012345678901234567
'123,456,789,012,345,678,901
'123456789012345678901
    dto$ s_line, d_teaquadpart, 0, 0
    $ch$ s_any, "0", 30
    s_line = s_any + s_line
    $off s_line, s_line, 21

    $cut s_beg, s_line, 1, 6
    $tod d_beg, s_beg
    d_beg = d_teaquadmult + d_beg
    $ch$ s_any, "0", 6
    s_beg = s_any + d_beg
    $off s_beg, s_beg, 6
    $rep s_line, 1, s_beg

    'put in commas in 21 digit number
    $ins s_line, 4, ","
    $ins s_line, 8, ","
    $ins s_line, 12, ","
    $ins s_line, 16, ","
    $ins s_line, 20, ","
    $ins s_line, 24, ","

    'take off leading zeros and commas
    d_dot = 1
    dwhi d_dot = 1
	  dinc d_dot
	  $cut s_any, s_line, 1, 1
	  $ift s_any = "0"
		$cut s_line, s_line, 2, 99
		d_dot = 1
	  endi
	  $ift s_any = ","
		$cut s_line, s_line, 2, 99
		d_dot = 1
	  endi
    endw

    sg_pass1 = s_line
ends sub_teaquad_to_string


subr sub_teaquad_from_string
'updated 2007/02/24, 2006/11/25, 2006/11/12, 2006/10/28
'teaquad string to d_teaquadpart,d_teaquadmult
'1part is the 15 digits on the right,1mult is the left digits
    vari d_any, s_any, d_dot, s_dot
    vari d_teaquadpart, d_teaquadmult
    vari s_line, d_good, d_long, s_beg, d_beg

    s_line = sg_pass1
    d_teaquadpart = 0
    d_teaquadmult = 0
'123456789012345678901234567
'123,456,789,012,345,678,901
'123456789012345678901

    d_good = 1
    dift d_good = 1
	  'eliminate commas and validate for all numbers
	  $trb s_line, s_line
	  $swp s_line, ",", sg_nothing
	  $ist d_any, s_line, "9"
	  dift d_any <> 1: dinc d_good
    endi
'123456789012345678901234567
'123,456,789,012,345,678,901
'123456789012345678901

    dift d_good = 1
	  'make 21 long
	  $ch$ s_any, "0", 30
	  s_line = s_any + s_line
	  $off s_line, s_line, 21

	  $cut s_beg, s_line, 1, 6
	  $tod d_teaquadmult, s_beg

	  $cut s_any, s_line, 7, 99
	  $tod d_teaquadpart, s_any
    endi

    dg_pass1 = d_teaquadpart
    dg_pass2 = d_teaquadmult
ends sub_teaquad_from_string


subr sub_teaquad_prime_speed_test
'updated 2007/09/08, 2007/09/07, 2006/08/27, 2006/08/26
'2006/03/03, 2005/12/11, 2005/10/08, 2004/02/15, 2004/02/14
'find the first 500,000 or 100,000 primes to test for speed
    vari d_any, s_any, d_dot, s_dot, s_out
    vari d_sec1, d_sec2, d_sec3, d_sec4, d_loop, d_count
    vari d_tofind, s_dash, d_process
    vari s_number1, s_number2, s_number3, d_factor
    vari d_teaquadpart, d_teaquadmult, d_teaquadone
    vari d_teaquadtotpart, d_teaquadtotmult
    vari d_teaquadbegmult, d_teaquadbegpart

    d_process = 1
    dift d_process = 1
	  $inp s_any, "enter 20=20 quadrillion, etc"
	  $ift s_any = "*": dinc d_process

	  d_teaquadbegpart = 1
	  d_teaquadbegmult = 20
	  $isd d_any, s_any
	  dift d_any = 1: $tod d_teaquadbegmult, s_any
    endi
    dift d_process = 1
        $ch$ s_dash, "-", 70
    
        dg_pass1 = d_teaquadbegpart
        dg_pass1 = d_teaquadbegmult
        sub_teaquad_to_string
        s_number1 = sg_pass1

        d_teaquadpart = d_teaquadbegpart
        d_teaquadmult = d_teaquadbegmult

        d_teaquadtotpart = 0
        d_teaquadtotmult = 0

        d_tofind = 10
    endi
    dsec d_sec1

    d_count = 0
    d_loop = d_process

    dwhi d_loop = 1 
	  'find primes with DFAC
	  dsec d_sec2
	  dfak d_factor, d_teaquadpart, d_teaquadmult
	  dsec d_sec3

	  dift d_factor = 1
	      'we have a prime
		d_sec4 = d_sec3 - d_sec2

		d_teaquadtotpart = d_teaquadtotpart + d_teaquadpart
		d_teaquadtotmult = d_teaquadtotmult + d_teaquadmult

		dinc d_count
		dift d_count >= d_tofind: dinc d_loop

		dg_pass1 = d_teaquadpart
		dg_pass2 = d_teaquadmult
		sub_teaquad_to_string
		$out d_count + ". " + sg_pass1 + " sec=" + d_sec4
	  endi

	  d_teaquadpart = d_teaquadpart + 2
    endw

    dsec d_sec2

    dift d_process = 1
        d_sec3 = d_sec2 - d_sec1

        $out s_dash

        $out "seconds=" + d_sec3

        $out "tot part=" + d_teaquadtotpart         
	  $out s_dash
	  d_dot = 0
	  d_any = d_teaquadbegmult	  
	  dift d_any = 1: d_dot = 1998
	  dift d_any = 2: d_dot = 1548
	  dift d_any = 3: d_dot = 1440
	  dift d_any = 4: d_dot = 1388
	  dift d_any = 5: d_dot = 1926
	  dift d_any = 10: d_dot = 3760
	  dift d_any = 20: d_dot = 1880
	  dift d_any = 30: d_dot = 1398
	  dift d_any = 40: d_dot = 2400
	  dift d_any = 50: d_dot = 1298
	  dift d_any = 60: d_dot = 2628
	  dift d_any = 70: d_dot = 3038
	  dift d_any = 80: d_dot = 1862
	  dift d_any = 90: d_dot = 778
	  dift d_any = 100: d_dot = 944
	  dift d_any = 200: d_dot = 2986
	  dift d_any = 300: d_dot = 1182
	  dift d_any = 400: d_dot = 2744
	  dift d_any = 500: d_dot = 1766
	  dift d_any = 600: d_dot = 2956
	  dift d_any = 700: d_dot = 2762
	  dift d_any = 800: d_dot = 2474
	  dift d_any = 900: d_dot = 3392
	  dift d_any = 1000: d_dot = 1734
	  dift d_any = 2000: d_dot = 2782
	  dift d_any = 3000: d_dot = 2700
	  dift d_any = 4000: d_dot = 1628
	  dift d_dot > 0: $out "tot part should be=" + d_dot

	  $out s_dash
       
        $inp s_any, "return"
    endi
ends sub_teaquad_prime_speed_test


subr sub_speed_test
'updated 2004/02/15
'speed of computer
    vari d_any, s_any, d_dot, s_dot
    vari d_sec1, d_sec2, d_sec3, d_count, d_total, s_dash

    $ch$ s_dash, "-", 76
    $out s_dash

    $out "We are looping 10,000,000 times"

    d_count = 0
    d_total = 10000 * 1000

    'loop one million times
    dsec d_sec1

    dwhi d_count < d_total
	  dinc d_count
    endw

    dsec d_sec2

    d_sec3 = d_sec2 - d_sec1

    $out "The time was " + d_sec3 + " seconds."

    $out s_dash  
    $inp s_any, "return"
ends sub_speed_test