'teamath.tea, begun on 15-JUN-2001
'Written in Teapro which uses the OpenTea technology
'In today's world, we need computer software that actually works.
vari sg_pass1, sg_pass2, sg_pass3, sg_pass4
vari dg_pass1, dg_pass2, dg_pass3, dg_pass4
vari dg_debug, sg_nothing
sub_main
endp
subr sub_main
'updated 2006/08/27, 2004/04/26
vari d_any, s_any, d_dot, s_dot
vari d_loop, s_pick, d_pick, s_debug
$trb sg_nothing, " "
dg_debug = 2
d_loop = 1
dwhi d_loop = 1
s_debug = ", debug off"
dift dg_debug = 1: s_debug = ", debug on"
$out "Program: teamath.tea, build 18, 2006/08/27"
$out "Copyright (c) 2001-2006 D La Pierre Ballard"
$out "Written in Teapro which uses the OpenTea technology"
$out "Copyright (c) 1997-2006 D La Pierre Ballard"
$out "This program was begun on 15-JUN-2001"
s_any = "In today's world, we need computer software"
$app s_any, " that actually works."
$out s_any
dsec d_any
$dat s_any
$out "Date=" + s_any + ", Time=" + d_any
sub_floating_point_test
'$out "1. do math" + s_debug
$out "2. 200calculate expression" + s_debug
'$out "9. do 200math"
$out "89. toggle debug"
$out "98. prime speed test"
$out "99. speed test"
$inp s_pick, "enter a number, * to end"
$isd d_any, s_pick
d_pick = 0
dift d_any = 1: $tod d_pick, s_pick
$ift s_pick = "*": dinc d_loop
'dift d_pick = 1: sub_math
dift d_pick = 2: sub_200calculate_expression
'dift d_pick = 9: sub_200math
dift d_pick = 89
dift dg_debug = 1
dinc dg_debug
else
dg_debug = 1
endi
endi
dift d_pick = 98: sub_prime_speed_test
dift d_pick = 99: sub_speed_test
endw
ends sub_main
subr sub_floating_point_test
'updated 2004/04/25
vari d_any, s_any, d_dot, s_dot, s_out
dpow d_any, 10, 14
d_any = d_any / 3
ded$ s_out, d_any, 0, 1
s_out = "10^14/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_math
'updated 2001/06/23
vari d_any, s_any, d_dot, s_dot
vari d_loop, s_pick, d_good, s_ruler
vari s_number1, s_number2, s_operator, s_answer
s_any = "1234567890"
s_dot = s_any + s_any + s_any
s_ruler = s_dot + s_dot + s_any
d_loop = 1
dwhi d_loop = 1
d_good = 1
dift d_good = 1
$ch$ s_any, "*", 70
$out s_any
$out "enter number1, blank=end"
$inp s_number1, s_ruler
$trb s_number1, s_number1
$len d_any, s_number1
dift d_any = 0
dinc d_good
dinc d_loop
endi
endi
dift d_good = 1
'validate s_number1
sg_pass1 = s_number1
sub_validate_number
d_good = dg_pass1
s_number1 = sg_pass1
endi
dift d_good = 1
$inp s_operator, "enter the operator, blank=end"
$trb s_operator, s_operator
$len d_any, s_operator
dift d_any = 0
dinc d_good
dinc d_loop
endi
endi
dift d_good = 1
'validate s_operator
s_any = "+-*/"
$lok d_any, s_any, 1, s_operator
dift d_any = 0
$out "bad operator = " + s_operator
dinc d_good
endi
endi
dift d_good = 1
$out "enter number2, blank=end"
$inp s_number2, s_ruler
$trb s_number2, s_number2
$len d_any, s_number2
dift d_any = 0
dinc d_good
dinc d_loop
endi
endi
dift d_good = 1
'validate s_number2
sg_pass1 = s_number2
sub_validate_number
d_good = dg_pass1
s_number2 = sg_pass1
endi
dift d_good = 1
s_answer = "0.0"
sg_pass1 = s_number1
sg_pass2 = s_number2
$ift s_operator = "+": sub_math_add
$ift s_operator = "-": sub_math_sub
$ift s_operator = "*": sub_math_mul
$ift s_operator = "/": sub_math_div
s_answer = sg_pass1
$ch$ s_any, "*", 70
$out s_any
$out "number1 = " + s_number1
$out "operator= " + s_operator
$out "number2 = " + s_number2
$out "the answer is:"
$len d_any, s_answer
dift d_any > 70
$cut s_any, s_answer, 1, 70
$out s_any
$cut s_any, s_answer, 71, 99999
$out s_any
else
$out s_answer
endi
$out s_ruler
endi
endw
ends sub_math
subr sub_math_add
'updated 2001/06/23
vari d_any, s_any, d_dot, s_dot
vari s_number1, s_number2, s_answer
vari d_byte, d_digit1, d_digit2
vari d_long1, d_long2, d_point1, d_point2
vari d_carry, d_total
s_number1 = sg_pass1
s_number2 = sg_pass2
dift dg_debug = 1
$out "1=" + s_number1
$out "2=" + s_number2
$inp s_any, "return"
endi
$lok d_point1, s_number1, 1, "."
$lok d_point2, s_number2, 1, "."
'make left of decimal the same
dift d_point1 > d_point2
d_any = d_point1 - d_point2
$ch$ s_any, "0", d_any
s_number2 = s_any + s_number2
endi
dift d_point2 > d_point1
d_any = d_point2 - d_point1
$ch$ s_any, "0", d_any
s_number1 = s_any + s_number1
endi
dift dg_debug = 1
$out "1=" + s_number1
$out "2=" + s_number2
$inp s_any, "return"
endi
'make right of decimal the same
$len d_long1, s_number1
$len d_long2, s_number2
dift d_long1 > d_long2
d_any = d_long1 - d_long2
$ch$ s_any, "0", d_any
$app s_number2, s_any
endi
dift d_long2 > d_long1
d_any = d_long2 - d_long1
$ch$ s_any, "0", d_any
$app s_number1, s_any
endi
dift dg_debug = 1
$out "1=" + s_number1
$out "2=" + s_number2
$inp s_any, "return"
endi
'eliminate decimal point
$lok d_point1, s_number1, 1, "."
$del s_number1, d_point1, 1
$del s_number2, d_point1, 1
dift dg_debug = 1
$out "1=" + s_number1
$out "2=" + s_number2
$inp s_any, "return"
endi
$len d_long1, s_number1
s_answer = ""
d_carry = 0
d_byte = d_long1
dwhi d_byte > 0
$cut s_any, s_number1, d_byte, 1
$tod d_digit1, s_any
$cut s_any, s_number2, d_byte, 1
$tod d_digit2, s_any
d_total = d_digit1 + d_digit2 + d_carry
d_carry = 0
dift d_total > 9
d_total = d_total - 10
d_carry = 1
endi
s_answer = d_total + s_answer
dift dg_debug = 1
$out "byte=" + d_byte
$out "answer=" + s_answer
endi
ddec d_byte
endw
dift d_carry = 1
s_answer = d_carry + s_answer
dinc d_point1
endi
$ins s_answer, d_point1, "."
sg_pass1 = s_answer
ends sub_math_add
subr sub_math_sub
'updated 2001/06/23
vari d_any, s_any, d_dot, s_dot
vari s_number1, s_number2, s_answer
vari d_byte, d_digit1, d_digit2
vari d_long1, d_long2, d_point1, d_point2
vari d_carry, d_total
s_number1 = sg_pass1
s_number2 = sg_pass2
dift dg_debug = 1
$out "1=" + s_number1
$out "2=" + s_number2
$inp s_any, "return"
endi
$lok d_point1, s_number1, 1, "."
$lok d_point2, s_number2, 1, "."
'make left of decimal the same
dift d_point1 > d_point2
d_any = d_point1 - d_point2
$ch$ s_any, "0", d_any
s_number2 = s_any + s_number2
endi
dift d_point2 > d_point1
d_any = d_point2 - d_point1
$ch$ s_any, "0", d_any
s_number1 = s_any + s_number1
endi
dift dg_debug = 1
$out "1=" + s_number1
$out "2=" + s_number2
$inp s_any, "return"
endi
'make right of decimal the same
$len d_long1, s_number1
$len d_long2, s_number2
dift d_long1 > d_long2
d_any = d_long1 - d_long2
$ch$ s_any, "0", d_any
$app s_number2, s_any
endi
dift d_long2 > d_long1
d_any = d_long2 - d_long1
$ch$ s_any, "0", d_any
$app s_number1, s_any
endi
dift dg_debug = 1
$out "1=" + s_number1
$out "2=" + s_number2
$inp s_any, "return"
endi
'make biggest number 1
$ift s_number2 > s_number1
s_any = s_number1
s_number1 = s_number2
s_number2 = s_any
endi
'eliminate decimal point
$lok d_point1, s_number1, 1, "."
$del s_number1, d_point1, 1
$del s_number2, d_point1, 1
dift dg_debug = 1
$out "1=" + s_number1
$out "2=" + s_number2
$inp s_any, "return"
endi
$len d_long1, s_number1
s_answer = ""
d_carry = 0
d_byte = d_long1
dwhi d_byte > 0
$cut s_any, s_number1, d_byte, 1
$tod d_digit1, s_any
$cut s_any, s_number2, d_byte, 1
$tod d_digit2, s_any
d_total = d_digit1 - d_digit2 - d_carry
d_carry = 0
dift d_total < 0
d_total = d_total + 10
d_carry = 1
endi
s_answer = d_total + s_answer
dift dg_debug = 1
$out "byte=" + d_byte
$out "answer=" + s_answer
endi
ddec d_byte
endw
dift d_carry = 1
s_answer = d_carry + s_answer
dinc d_point1
endi
$ins s_answer, d_point1, "."
sg_pass1 = s_answer
ends sub_math_sub
subr sub_math_mul
'numbers are in 200 format
'updated 2001/06/24
vari d_any, s_any, d_dot, s_dot
vari s_number1, s_number2, s_answer, s_addnum
vari s_zeros, d_byte, s_byte, d_loop, s_sum
vari d_pit, d_digit1, d_digit2, d_carry, d_total
vari s_num1, s_num2, s_num3
vari s_num4, s_num5, s_num6
vari s_num7, s_num8, s_num9
vari d_long1, d_long2, d_point1, d_point2
vari d_places
s_number1 = sg_pass1
s_number2 = sg_pass2
'get the total number of decimal places
$len d_long1, s_number1
$len d_long2, s_number2
$lok d_point1, s_number1, 1, "."
$lok d_point2, s_number2, 1, "."
d_places = d_long1 - d_point1 + d_long2 - d_point2
'remove the decimals
$del s_number1, d_point1, 1
$del s_number2, d_point2, 1
$ch$ s_zeros, "0", 200
'get multipliers
sg_pass1 = s_number1
sg_pass2 = s_number1
sub_math_add
s_num2 = sg_pass1
sg_pass2 = s_number1
sub_math_add
s_num3 = sg_pass1
sg_pass2 = s_number1
sub_math_add
s_num4 = sg_pass1
sg_pass2 = s_number1
sub_math_add
s_num5 = sg_pass1
sg_pass2 = s_number1
sub_math_add
s_num6 = sg_pass1
sg_pass2 = s_number1
sub_math_add
s_num7 = sg_pass1
sg_pass2 = s_number1
sub_math_add
s_num8 = sg_pass1
sg_pass2 = s_number1
sub_math_add
s_num9 = sg_pass1
$ch$ s_answer, "0", 400
d_byte = 200
dwhi d_byte > 0
$cut s_byte, s_number2, d_byte, 1
$ift s_byte <> "0"
$tod d_digit2, s_byte
d_dot = 201 - d_byte
dift d_digit2 = 1: $cut s_addnum, s_num1, d_dot, 400
dift d_digit2 = 2: $cut s_addnum, s_num2, d_dot, 400
dift d_digit2 = 3: $cut s_addnum, s_num3, d_dot, 400
dift d_digit2 = 4: $cut s_addnum, s_num4, d_dot, 400
dift d_digit2 = 5: $cut s_addnum, s_num5, d_dot, 400
dift d_digit2 = 6: $cut s_addnum, s_num6, d_dot, 400
dift d_digit2 = 7: $cut s_addnum, s_num7, d_dot, 400
dift d_digit2 = 8: $cut s_addnum, s_num8, d_dot, 400
dift d_digit2 = 9: $cut s_addnum, s_num9, d_dot, 400
'add s_addnum to s_answer
s_sum = ""
d_carry = 0
d_pit = 400
dwhi d_pit > 0
$cut s_any, s_answer, d_pit, 1
$tod d_digit1, s_any
$cut s_any, s_addnum, d_pit, 1
$tod d_digit2, s_any
d_total = d_digit1 + d_digit2 + d_carry
d_carry = 0
dift d_total > 9
d_total = d_total - 10
d_carry = 1
endi
s_sum = d_total + s_sum
ddec d_pit
endw
s_answer = s_sum
dift dg_debug = 1
$cut s_any, s_answer, 101, 200
sg_pass1 = s_any
sub_200math_show
$inp s_any, "d_byte=" + d_byte + ", d_digit=" + s_byte
endi
endi
ddec d_byte
endw
$cut s_answer, s_answer, 101, 200
sg_pass1 = s_answer
ends sub_math_mul
subr sub_math_div
'updated 2001/06/19
vari d_any, s_any, d_dot, s_dot
ends sub_math_div
subr sub_validate_number
'validate number in sg_pass1
'updated 2001/06/22
vari d_any, s_any, d_dot, s_dot
vari d_good, s_numerals, d_long, d_byte
vari s_number
s_number = sg_pass1
s_numerals = "0123456789"
d_good = 1
$len d_long, s_number
d_dot = 0
d_byte = 1
dwhi d_byte <= d_long
$cut s_dot, s_number, d_byte, 1
$ift s_dot = "."
dinc d_dot
else
$lok d_any, s_numerals, 1, s_dot
dift d_any = 0: dinc d_good
endi
dinc d_byte
endw
dift d_dot > 1: dinc d_good
dift d_good <> 1: $out "bad=" + s_number
'format the number
dift d_good = 1
$len d_long, s_number
$lok d_dot, s_number, 1, "."
dift d_dot = 0: $app s_number, ".0"
dift d_dot = 1: s_number = "0" + s_number
dift d_dot = d_long: $app s_number, "0"
endi
dg_pass1 = d_good
sg_pass1 = s_number
ends sub_validate_number
subr sub_200calculate_expression
'updated 2004/04/25
vari d_any, s_any, d_dot, s_dot, s_out
vari d_loop1, d_loop2, d_good
vari s_number1, s_operator, s_number2, s_answer
vari s_xvalue, s_expression, s_line
vari d_time, d_long, d_byte, s_byte, d_beg
vari s_numbers
s_numbers = "0123456789."
d_loop1 = 1
dwhi d_loop1 = 1
s_answer = "0.0"
s_number1 = "0.0"
s_xvalue = "0.0"
d_good = 1
$inp s_expression, "enter expression, x=3*2, * to end"
dsec d_time
$trb s_expression, s_expression
$cup s_expression, s_expression
s_line = s_expression
$swp s_line, " ", sg_nothing
$swp s_line, ",", sg_nothing
$ift s_line = "*"
dinc d_loop1
dinc d_good
endi
$cut s_any, s_line, 1, 2
$ift s_any <> "X=": dinc d_good
dift d_good = 1
$cut s_line, s_line, 3, 99999
$app s_line, ";"
$cut s_any, s_line, 1, 1
s_dot = "+-"
$lok d_any, s_dot, 1, s_any
dift d_any = 0: s_line = "+" + s_line
d_byte = 2
d_loop2 = 1
dwhi d_loop2 = 1
$cut s_byte, s_line, d_byte, 1
$lok d_any, s_numbers, 1, s_byte
dift d_any = 0
'not a number at d_byte
d_long = d_byte - 2
$cut s_number2, s_line, 2, d_long
$cut s_operator, s_line, 1, 1
'prep for the next
$cut s_line, s_line, d_byte, 99999
d_byte = 1
'validate s_number2
sg_pass1 = s_number1
sg_pass2 = s_operator
sg_pass3 = s_number2
sub_auto200math
d_good = dg_pass1
dift d_good = 1
s_number1 = sg_pass4
s_answer = sg_pass4
else
dinc d_loop2
endi
endi
dinc d_byte
$cut s_any, s_line, 1, 1
$ift s_any = ";": dinc d_loop2
endw
dsec d_any
d_time = d_any - d_time
$out "seconds=" + d_time
'put in commas
sg_pass1 = s_answer
sub_put_in_commas
s_answer = sg_pass1
$len d_any, s_answer
dift d_any > 70
$cut s_any, s_answer, 1, 70
$out "X=" + s_any
$cut s_any, s_answer, 71, 99999
$out s_any
else
$out "X=" + s_answer
endi
endi
endw
ends sub_200calculate_expression
subr sub_auto200math
'updated 2004/04/26
'num1=sg_pass1,operator=sg_pass2,num2=sg_pass3,ans=sg_pass4
vari d_any, s_any, d_dot, s_dot, s_out
vari d_loop, s_pick, d_good
vari s_number1, s_number2, s_operator, s_answer
vari s_200num1, s_200num2
s_number1 = sg_pass1
s_operator = sg_pass2
s_number2 = sg_pass3
dift dg_debug = 1
$out "number1=" + s_number1
$out "operator=" + s_operator
$out "number2=" + s_number2
$inp s_any, "return"
endi
d_good = 1
dift d_good = 1
'validate s_number1
sg_pass1 = s_number1
sub_200math_validate
d_good = dg_pass1
endi
dift d_good = 1
'validate s_operator
s_any = "+-*/"
$lok d_any, s_any, 1, s_operator
dift d_any = 0
$out "bad operator = " + s_operator
dinc d_good
endi
endi
dift d_good = 1
'validate s_number2
sg_pass1 = s_number2
sub_200math_validate
d_good = dg_pass1
endi
dift d_good = 1
'prep numbers to 200
sg_pass1 = s_number1
sub_200math_prep
s_200num1 = sg_pass1
sg_pass1 = s_number2
sub_200math_prep
s_200num2 = sg_pass1
endi
dift d_good = 1
s_answer = "0.0"
sg_pass1 = s_200num1
sg_pass2 = s_200num2
$ift s_operator = "+": sub_200math_add
$ift s_operator = "-": sub_200math_sub
$ift s_operator = "*": sub_200math_mul
$ift s_operator = "/": sub_200math_div
sub_200math_unprep
s_answer = sg_pass1
dift dg_debug = 1
$ch$ s_any, "*", 70
$out s_any
$out "number1 = " + s_number1
$out "operator= " + s_operator
$out "number2 = " + s_number2
$out "the answer is:"
$trb s_answer, s_answer
$len d_any, s_answer
dift d_any > 70
$cut s_any, s_answer, 1, 70
$out s_any
$cut s_any, s_answer, 71, 99999
$out s_any
else
$out s_answer
endi
$inp s_any, "return"
endi
endi
sg_pass4 = s_answer
dg_pass1 = d_good
ends sub_auto200math
subr sub_put_in_commas
'updated 2004/04/26
vari d_any, s_any, d_dot, s_dot
vari d_loop, s_pick, d_good
vari s_number, d_byte
s_number = sg_pass1
$trb s_number, s_number
$swp s_number, ",", sg_nothing
$lok d_byte, s_number, 1, "."
d_loop = 2
dift d_byte > 4: d_loop = 1
dwhi d_loop = 1
d_byte = d_byte - 3
dift d_byte > 1
$ins s_number, d_byte, ","
else
dinc d_loop
endi
endw
sg_pass1 = s_number
ends sub_put_in_commas
subr sub_200math
'updated 2001/07/10
vari d_any, s_any, d_dot, s_dot
vari d_loop, s_pick, d_good, s_ruler, d_time
vari s_number1, s_number2, s_operator, s_answer
vari s_200num1, s_200num2, s_dashes
$ch$ s_dashes, "-", 70
s_any = "1234567890"
s_dot = s_any + s_any + s_any
s_ruler = s_dot + s_dot + s_any
d_loop = 1
dwhi d_loop = 1
d_good = 1
dift d_good = 1
$ch$ s_any, "*", 70
$out s_any
$out "enter number1, blank=end"
$inp s_number1, s_ruler
$trb s_number1, s_number1
$len d_any, s_number1
dift d_any = 0
dinc d_good
dinc d_loop
endi
endi
dift d_good = 1
'validate s_number1
sg_pass1 = s_number1
sub_200math_validate
d_good = dg_pass1
endi
dift d_good = 1
$inp s_operator, "enter the operator, blank=end"
$trb s_operator, s_operator
$len d_any, s_operator
dift d_any = 0
dinc d_good
dinc d_loop
endi
endi
dift d_good = 1
'validate s_operator
s_any = "+-*/"
$lok d_any, s_any, 1, s_operator
dift d_any = 0
$out "bad operator = " + s_operator
dinc d_good
endi
endi
dift d_good = 1
$out "enter number2, blank=end"
$inp s_number2, s_ruler
$trb s_number2, s_number2
$len d_any, s_number2
dift d_any = 0
dinc d_good
dinc d_loop
endi
endi
dift d_good = 1
'validate s_number2
sg_pass1 = s_number2
sub_200math_validate
d_good = dg_pass1
endi
dift d_good = 1
'prep numbers to 200
sg_pass1 = s_number1
sub_200math_prep
s_200num1 = sg_pass1
sg_pass1 = s_number2
sub_200math_prep
s_200num2 = sg_pass1
endi
dift d_good = 1
dsec d_time
s_answer = "0.0"
sg_pass1 = s_200num1
sg_pass2 = s_200num2
$ift s_operator = "+": sub_200math_add
$ift s_operator = "-": sub_200math_sub
$ift s_operator = "*": sub_200math_mul
$ift s_operator = "/": sub_200math_div
sub_200math_unprep
s_answer = sg_pass1
$ch$ s_any, "*", 70
$out s_any
$out "number1 = " + s_number1
$out "operator= " + s_operator
$out "number2 = " + s_number2
$out s_dashes
$out "the answer is:"
$len d_any, s_answer
dift d_any > 70
$cut s_any, s_answer, 1, 70
$out s_any
$cut s_any, s_answer, 71, 99999
$out s_any
else
$out s_answer
endi
dsec d_any
$out s_dashes
d_time = d_any - d_time
$out s_ruler
$out "seconds=" + d_time
endi
endw
ends sub_200math
subr sub_200math_add
'numbers are in 200 format
'updated 2001/06/17
vari d_any, s_any, d_dot, s_dot
vari s_number1, s_number2, s_answer
vari d_long, d_byte
vari d_digit1, d_digit2, d_total, d_carry
vari s_digit1, s_digit2
s_number1 = sg_pass1
s_number2 = sg_pass2
dift dg_debug = 1
sg_pass1 = s_number1
sub_200math_show
sg_pass1 = s_number2
sub_200math_show
endi
s_answer = ""
d_carry = 0
d_byte = 200
dwhi d_byte > 0
$cut s_digit1, s_number1, d_byte, 1
$tod d_digit1, s_digit1
$cut s_digit2, s_number2, d_byte, 1
$tod d_digit2, s_digit2
d_total = d_digit1 + d_digit2 + d_carry
d_carry = 0
dift d_total > 9
d_total = d_total - 10
d_carry = 1
endi
s_answer = d_total + s_answer
ddec d_byte
endw
dift dg_debug = 1
sg_pass1 = s_answer
sub_200math_show
endi
sg_pass1 = s_answer
ends sub_200math_add
subr sub_200math_sub
'numbers are in 200 format
'updated 2001/06/17
vari d_any, s_any, d_dot, s_dot
vari s_number1, s_number2, s_answer
vari d_long, d_byte
vari d_digit1, d_digit2, d_total, d_carry
vari s_digit1, s_digit2
s_number1 = sg_pass1
s_number2 = sg_pass2
dift dg_debug = 1
sg_pass1 = s_number1
sub_200math_show
sg_pass1 = s_number2
sub_200math_show
endi
s_answer = ""
d_carry = 0
d_byte = 200
dwhi d_byte > 0
$cut s_digit1, s_number1, d_byte, 1
$tod d_digit1, s_digit1
$cut s_digit2, s_number2, d_byte, 1
$tod d_digit2, s_digit2
d_total = d_digit1 - d_digit2 - d_carry
d_carry = 0
dift d_total < 0
d_total = d_total + 10
d_carry = 1
endi
s_answer = d_total + s_answer
ddec d_byte
endw
sg_pass1 = s_answer
ends sub_200math_sub
subr sub_200math_mul
'numbers are in 200 format
'updated 2001/06/30
vari d_any, s_any, d_dot, s_dot
vari s_number1, s_number2, s_answer, s_addnum
vari s_zeros, d_byte, s_byte, d_loop, s_sum
vari d_pit, d_digit1, d_digit2, d_carry, d_total
s_number1 = sg_pass1
s_number2 = sg_pass2
$ch$ s_zeros, "0", 200
'get multiples of s_number1
sg_pass1 = s_zeros
sg_pass2 = s_number1
d_dot = 1
dwhi d_dot < 10
sub_200math_add
s_any = s_zeros + sg_pass1 + s_zeros
$toi d_dot, s_any
dinc d_dot
endw
$ch$ s_answer, "0", 200
d_byte = 200
dwhi d_byte > 0
$cut s_byte, s_number2, d_byte, 1
$ift s_byte <> "0"
$tod d_digit2, s_byte
d_dot = 301 - d_byte
ito$ s_any, d_digit2
$cut s_addnum, s_any, d_dot, 200
sg_pass1 = s_answer
sg_pass2 = s_addnum
sub_200math_add
s_answer = sg_pass1
dift dg_debug = 1
sg_pass1 = s_answer
sub_200math_show
$inp s_any, "d_byte=" + d_byte + ", d_digit=" + s_byte
endi
endi
ddec d_byte
endw
sg_pass1 = s_answer
ends sub_200math_mul
subr sub_200math_div
'updated 2001/07/02
vari d_any, s_any, d_dot, s_dot
vari s_number1, s_number2, s_answer, s_subnum
vari s_zeros, d_byte, s_byte, s_shift
vari d_pit, d_digit1, d_digit2, d_carry, d_total
vari d_loop1, d_loop2, s_remainder, d_index
vari d_left1, d_left2, d_places1, d_places2, d_placesleft
s_number1 = sg_pass1
s_number2 = sg_pass2
$ch$ s_zeros, "0", 200
'find number of digits left of the decimal
'for each
d_left1 = 0
d_left2 = 0
d_byte = 1
d_loop1 = 1
dwhi d_loop1 < 3
dift d_left1 = 0
$cut s_byte, s_number1, d_byte, 1
$ift s_byte <> "0"
d_left1 = d_byte
dinc d_loop1
endi
endi
dift d_left2 = 0
$cut s_byte, s_number2, d_byte, 1
$ift s_byte <> "0"
d_left2 = d_byte
dinc d_loop1
endi
endi
dinc d_byte
dift d_byte > 200: dinc d_loop1
endw
d_places1 = 101 - d_left1
d_places2 = 101 - d_left2
dift dg_debug = 1
$out "places1=" + d_places1 + ", places2=" + d_places2
endi
d_placesleft = d_places1 - d_places2
d_left1 = d_left1 - 5
ddec d_left2
$app s_number1, s_zeros
$app s_number2, s_zeros
$cut s_number1, s_number1, d_left1, 200
$cut s_number2, s_number2, d_left2, 200
dift dg_debug = 1
sg_pass1 = s_number1
sg_pass2 = "n1="
sub_200math_out
sg_pass1 = s_number2
sg_pass2 = "n2="
sub_200math_out
endi
'get multiples of s_number2
sg_pass2 = s_number2
s_subnum = s_zeros
d_dot = 1
dwhi d_dot < 10
sg_pass1 = s_subnum
sg_pass2 = s_number2
sub_200math_add
s_subnum = sg_pass1
$toi d_dot, s_subnum
dift dg_debug = 1
sg_pass1 = s_subnum
sg_pass2 = "mult="
sub_200math_out
endi
dinc d_dot
endw
dift dg_debug = 1
$inp s_any, "subtractors above"
endi
s_remainder = s_number1
s_shift = ""
s_answer = ""
d_byte = 1
d_loop1 = 1
dwhi d_loop1 = 1
d_index = 9
d_loop2 = 1
dwhi d_loop2 = 1
ito$ s_subnum, d_index
s_subnum = s_shift + s_subnum
$cut s_subnum, s_subnum, 1, 200
$ift s_subnum <= s_remainder
dift dg_debug = 1
sg_pass1 = s_remainder
sg_pass2 = "1="
sub_200math_out
sg_pass1 = s_subnum
sg_pass2 = "2="
sub_200math_out
endi
sg_pass1 = s_remainder
sg_pass2 = s_subnum
sub_200math_sub
s_remainder = sg_pass1
dift dg_debug = 1
sg_pass1 = s_remainder
sg_pass2 = "3="
sub_200math_out
endi
$app s_answer, d_index
dift dg_debug = 1
$out "4=" + s_answer
$inp s_any, "subtraction and answer"
endi
dinc d_loop2
else
ddec d_index
dift d_index = 0
$app s_answer, "0"
dinc d_loop2
endi
endi
endw
$app s_shift, "0"
dinc d_byte
dift d_byte > 80: dinc d_loop1
endw
$ch$ s_zeros, "0", 200
s_answer = s_zeros + s_answer + s_zeros
d_any = d_placesleft + 106
$cut s_answer, s_answer, d_any, 200
dift dg_debug = 1
sg_pass1 = s_answer
sg_pass2 = "ans="
sub_200math_out
endi
sg_pass1 = s_answer
ends sub_200math_div
subr sub_good200math_div
'updated 2001/07/02
vari d_any, s_any, d_dot, s_dot
vari s_number1, s_number2, s_answer, s_subnum
vari s_zeros, d_byte, s_byte, s_shift
vari d_pit, d_digit1, d_digit2, d_carry, d_total
vari d_loop1, d_loop2, s_remainder, d_index
vari d_left1, d_left2, d_places1, d_places2, d_placesleft
s_number1 = sg_pass1
s_number2 = sg_pass2
$ch$ s_zeros, "0", 200
'find number of digits left of the decimal
'for each
d_left1 = 0
d_left2 = 0
d_byte = 1
d_loop1 = 1
dwhi d_loop1 < 3
dift d_left1 = 0
$cut s_byte, s_number1, d_byte, 1
$ift s_byte <> "0"
d_left1 = d_byte
dinc d_loop1
endi
endi
dift d_left2 = 0
$cut s_byte, s_number2, d_byte, 1
$ift s_byte <> "0"
d_left2 = d_byte
dinc d_loop1
endi
endi
dinc d_byte
dift d_byte > 200: dinc d_loop1
endw
d_places1 = 101 - d_left1
d_places2 = 101 - d_left2
$out "places1=" + d_places1 + ", places2=" + d_places2
d_placesleft = d_places1 - d_places2
'$ift s_number1 > s_number2: dinc d_placesleft
d_left1 = d_left1 - 5
ddec d_left2
$app s_number1, s_zeros
$app s_number2, s_zeros
$cut s_number1, s_number1, d_left1, 200
$cut s_number2, s_number2, d_left2, 200
sg_pass1 = s_number1
sg_pass2 = "n1="
sub_200math_out
sg_pass1 = s_number2
sg_pass2 = "n2="
sub_200math_out
'get multiples of s_number2
sg_pass2 = s_number2
s_subnum = s_zeros
d_dot = 1
dwhi d_dot < 10
sg_pass1 = s_subnum
sg_pass2 = s_number2
sub_200math_add
s_subnum = sg_pass1
$toi d_dot, s_subnum
sg_pass1 = s_subnum
sg_pass2 = "mult="
sub_200math_out
dinc d_dot
endw
$inp s_any, "subtractors above"
s_remainder = s_number1
s_shift = ""
s_answer = ""
d_byte = 1
d_loop1 = 1
dwhi d_loop1 = 1
d_index = 9
d_loop2 = 1
dwhi d_loop2 = 1
ito$ s_subnum, d_index
s_subnum = s_shift + s_subnum
$cut s_subnum, s_subnum, 1, 200
$ift s_subnum <= s_remainder
sg_pass1 = s_remainder
sg_pass2 = "1="
sub_200math_out
sg_pass1 = s_subnum
sg_pass2 = "2="
sub_200math_out
sg_pass1 = s_remainder
sg_pass2 = s_subnum
sub_200math_sub
s_remainder = sg_pass1
sg_pass1 = s_remainder
sg_pass2 = "3="
sub_200math_out
s_answer = s_answer + d_index
$out "4=" + s_answer
$inp s_any, "subtraction and answer"
dinc d_loop2
else
ddec d_index
dift d_index = 0
$app s_answer, "0"
dinc d_loop2
endi
endi
endw
$app s_shift, "0"
dinc d_byte
dift d_byte > 40: dinc d_loop1
endw
$ch$ s_zeros, "0", 200
s_answer = s_zeros + s_answer + s_zeros
d_any = d_placesleft + 106
$cut s_answer, s_answer, d_any, 200
sg_pass1 = s_answer
sg_pass2 = "ans="
sub_200math_out
sg_pass1 = s_answer
ends sub_good200math_div
subr sub_200math_out
'updated 2001/07/01
vari d_any, s_any, d_dot, s_dot
vari s_out1, s_out2
s_out1 = sg_pass1
s_out2 = sg_pass2
$cut s_any, s_out1, 1, 60
$out s_out2 + s_any
ends sub_200math_out
subr sub_200math_show
'updated 2001/06/17
vari d_any, s_any, d_dot, s_dot
vari s_zeros
s_dot = sg_pass1
sub_200math_unprep
$out sg_pass1
$ch$ s_zeros, "0", 70
$cut s_any, s_dot, 1, 70
$ift s_any <> s_zeros: $out s_any
$cut s_any, s_dot, 71, 70
$out s_any
$cut s_any, s_dot, 141, 60
$ch$ s_zeros, "0", 60
$ift s_any <> s_zeros: $out s_any
ends sub_200math_show
subr sub_200math_validate
'validate number in sg_pass1
'updated 2001/06/15
vari d_any, s_any, d_dot, s_dot
vari d_good, s_numerals, d_long, d_byte
vari s_number
s_number = sg_pass1
s_numerals = "0123456789"
d_good = 1
$len d_long, s_number
d_dot = 0
d_byte = 1
dwhi d_byte <= d_long
$cut s_dot, s_number, d_byte, 1
$ift s_dot = "."
dinc d_dot
else
$lok d_any, s_numerals, 1, s_dot
dift d_any = 0: dinc d_good
endi
dinc d_byte
endw
dift d_dot > 1: dinc d_good
dift d_good <> 1: $out "bad=" + s_number
dg_pass1 = d_good
ends sub_200math_validate
subr sub_200math_prep
'fix so 200 long no decimal 100 on each side
'updated 2001/06/17
vari d_any, s_any, d_dot, s_dot
vari s_number, s_zeros, d_long
s_number = sg_pass1
$lok d_dot, s_number, 1, "."
dift d_dot = 0: $app s_number, "."
$ch$ s_zeros, "0", 100
s_number = s_zeros + s_number + s_zeros
$lok d_dot, s_number, 1, "."
d_any = d_dot + 100
$cut s_number, s_number, 1, d_any
d_any = d_dot - 100
$cut s_number, s_number, d_any, 99999
'eliminate the decimal
$del s_number, 101, 1
sg_pass1 = s_number
ends sub_200math_prep
subr sub_200math_unprep
'updated 2001/06/17
vari s_number
s_number = sg_pass1
$ins s_number, 101, "."
sg_pass1 = s_number
sub_200math_trim
'return sg_pass1
ends sub_200math_unprep
subr sub_200math_trim
'updated 2001/06/17
vari d_any, s_any, d_dot, s_dot
vari s_number, d_loop, d_long
s_number = sg_pass1
d_dot = 1
d_loop = 1
dwhi d_loop = 1
$cut s_any, s_number, d_dot, 1
$ift s_any <> "0"
dinc d_loop
else
dinc d_dot
endi
endw
$cut s_number, s_number, d_dot, 99999
$len d_dot, s_number
d_loop = 1
dwhi d_loop = 1
$cut s_any, s_number, d_dot, 1
$ift s_any <> "0"
dinc d_loop
else
ddec d_dot
endi
endw
$cut s_number, s_number, 1, d_dot
$len d_long, s_number
$lok d_dot, s_number, 1, "."
dift d_dot = 0: $app s_number, ".0"
dift d_dot = 1: s_number = "0" + s_number
dift d_dot = d_long: $app s_number, "0"
sg_pass1 = s_number
ends sub_200math_trim
subr sub_200math_left
'left justify a 200math number
'updated 2001/07/01
vari d_any, s_any, d_dot, s_dot
vari s_number, d_loop, d_long
$ch$ s_any, "0", 200
s_number = sg_pass1 + s_any
d_dot = 1
d_loop = 1
dwhi d_loop = 1
$cut s_dot, s_number, d_dot, 1
$ift s_dot = "0"
dinc d_dot
dift d_dot > 200: dinc d_loop
else
dinc d_loop
endi
endw
$cut sg_pass1, s_number, d_dot, 200
ends sub_200math_left
subr sub_prime_speed_test
'updated 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_loop, d_count
vari d_todocount, s_dash, d_action, d_tealines
vari d_testprime, d_primetotal, d_lastprime
dsys d_tealines, 2
'd_action=1 for using DFAC
'd_action=2 for not using DFAC
d_action = 2
dift d_action < 99
$ch$ s_dash, "-", 76
$inp s_any, "1=use dfac"
$ift s_any = "*": d_action = 99999
$ift s_any = "1": d_action = 1
endi
dift d_action = 1
'use DFAC 500,000
d_todocount = 500 * 1000
ded$ s_any, d_todocount, 0, 0
$out "finding the first " + s_any + " primes"
endi
dift d_action = 2
'do not use DFAC 100,000
d_todocount = 100 * 1000
ded$ s_any, d_todocount, 0, 0
$out "finding the first " + s_any + " primes"
endi
dsec d_sec1
d_primetotal = 1 + 2 + 3
d_lastprime = 3
'1,2,3 are presumed
d_count = 3
d_testprime = 5
d_loop = d_action
dwhi d_loop = 1
'find primes with DFAC
dfac d_any, d_testprime
dift d_any = 1
'we have a prime
d_lastprime = d_testprime
d_primetotal = d_primetotal + d_testprime
dinc d_count
dift d_count >= d_todocount: d_loop = 99
endi
d_testprime = d_testprime + 2
endw
dwhi d_loop = 2
'find primes without DFAC
dg_pass1 = d_testprime
sub_prime_test_simple
dift dg_pass1 = 1
'we have a prime
d_lastprime = d_testprime
d_primetotal = d_primetotal + d_testprime
dinc d_count
dift d_count >= d_todocount: d_loop = 99
endi
d_testprime = d_testprime + 2
endw
dsec d_sec2
dift d_action < 99
d_sec3 = d_sec2 - d_sec1
$out s_dash
ded$ s_any, d_primetotal, 0, 0
$out "Prime total = " + s_any
ded$ s_any, d_lastprime, 0, 0
$out "Last prime = " + s_any
ded$ s_any, d_count, 0, 0
$out "Primes count = " + s_any
$out s_dash
endi
dift d_action = 1
$out "The above numbers should be as follows."
$out "Prime total = 1,774,817,902,653"
$out "Last prime = 7,368,743"
$out "Primes count = 500,000"
$out s_dash
$out "The time was " + d_sec3 + " seconds."
$out s_dash
endi
dift d_action = 2
$out "The above numbers should be as follows."
$out "Prime total = 62,259,399,013"
$out "Last prime = 1,299,689"
$out "Primes count = 100,000"
$out s_dash
$out "The time was " + d_sec3 + " seconds."
$out s_dash
endi
dsys d_any, 2
d_tealines = d_any - d_tealines
ded$ s_any, d_tealines, 0, 0
$out "total lines=" + s_any
$inp s_any, "return"
ends sub_prime_speed_test
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_speed_test
'speed of computer
'updated 2002/09/27
vari d_any, s_any, d_dot, s_dot
vari s_dash, d_4pentium1dot7
vari d_sec1, d_sec2, d_sec3, d_count, d_total
$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
d_4pentium1dot7 = 14
$out "looping 10,000,000 times"
$out "The time was " + d_sec3 + " seconds."
s_any = "A Pentium-IV-1.7 will do this in about "
$app s_any, d_4pentium1dot7 + " seconds."
$out s_any
d_any = d_4pentium1dot7 / d_sec3
$out "The ratio of this computer to a Pentium-IV-1.7 is=" + d_any
$out s_dash
$inp s_any, "return"
ends sub_speed_test