'beginning the teasho.tea program written in Teapro 'which utilizes 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_now, sg_now, dg_endprogram, dg_speedquick vari sg_build, dg_length, sg_loadprog, sg_nothing vari dg_xvalue, dg_yvalue, dg_zvalue, sg_xyzmath vari sg_path, sg_lines, sg_interpreter, sg_memory sub_main endp subr sub_main 'updated 2003/01/29 'main subroutine dg_endprogram = 2 dwhi dg_endprogram <> 1 sub_menu0 endw ends sub_main subr sub_menu0 'updated 2011/09/26, 2011/09/12, 2008/02/25 '2007/11/12, 2007/07/17, 2007/03/09, 2006/09/27, 2006/09/25 '2005/10/07, 2005/04/19, 2005/04/18, 2005/02/28, 2004/10/19 'menu of possibilities vari d_any, s_any, d_dot, s_dot, s_out vari d_inp, d_seconds, s_xvalue, s_aster, s_speedquick vari s_pick, d_pick $trb sg_nothing, " " $ch$ s_aster, "*", 70 $out s_aster sg_build = "Program: teasho.tea, build=131, 2012/03/24" $out sg_build $out "Copyright (c) 1998-2012 D La Pierre Ballard." $out "Written in Teapro using the OpenTea technology" $out "Copyright (c) 1997-2011 by D La Pierre Ballard." $out "This program was begun on 1998/04/03" $out "This program may be used by anyone, but there is" $out "no warranty of anykind on this program." $out s_aster s_any = "People need computer software that actually works." $out s_any $out s_aster dsec d_seconds ded$ s_out, d_seconds, 0, 0 $out #seconds = # + s_out $dat s_out $out s_out sub_floating_point_test $out s_aster sub_path_prog_memory sub_speedquick s_speedquick = sg_pass1 $out s_aster $out "1 = sub_menu_files_and_chars" $out "2 = sub_menu_proc_files" $out "3 = sub_menu_numbers" $out "5 = sub_menu_floating_point" $out "6 = sub_menu_programming" $out "7 = sub_menu_testing" $out "96 = sub_xyzmath " + sg_path + " " + sg_lines $out "97 = sub_prime_speed_test " + sg_interpreter + " " + sg_memory $out "98 = sub_speed98_test " + sg_build + " " + sg_loadprog $out "99 = sub_speed_test " + s_speedquick $inp s_pick, "pick a number *=end " + "x=" + dg_xvalue $isd d_any, s_pick d_pick = 0 dift d_any = 1: $tod d_pick, s_pick $ift s_pick = "*": dg_endprogram = 1 dift d_pick = 1: sub_menu_files_and_chars dift d_pick = 2: sub_menu_proc_files dift d_pick = 3: sub_menu_numbers dift d_pick = 5: sub_menu_floating_point dift d_pick = 6: sub_menu_programming dift d_pick = 7: sub_menu_testing dift d_pick = 96 sg_pass1 = "x=x" sub_xyzmath endi dift d_pick = 97: sub_prime_speed_test dift d_pick = 98: sub_speed98_test dift d_pick = 99: sub_speed_test sg_pass1 = s_pick sub_xyzmath ends sub_menu0 subr sub_menu_files_and_chars 'updated 2006/08/07 '2006/04/13, 2005/09/21, 2005/07/24, 2005/04/18, 2004/05/11 vari s_any, d_any, s_dot, d_dot vari s_pick, d_pick, s_out, d_inp $out "1 = speed" $out "2 = watch time change" $out "11 = character Set" $out "12 = characters in a file" $out "13 = readable characters in a file" $out "14 = read a file by lines" $out "15 = look for duplicate fields between records" $out "16 = paste whole file into $inp" $out "17 = count particular string in file" $out "18 = remove duplicate records from a file" $out "24 = read in whole file, lookups, replace" $out "25 = save part of a file into a new file" $out "28 = zero divide to crash the program" $out "30 = copy file to new file using fsip, fapp" $out "31 = make file uppercase or lowercase" $out "32 = to oldtoe a file" $out "41 = hash a string" $out "42 = total characters in a file" $inp s_pick, "enter number,* = end, x=" + dg_xvalue $isd d_any, s_pick d_pick = 0 dift d_any = 1: $tod d_pick, s_pick 'Speed dift d_pick = 1: sub_speed2 'watch time change dift d_pick = 2: sub_time_watch 'Characters dift d_pick = 11: sub_characters 'Characters in a file dift d_pick = 12: sub_char_in_file 'Readable characters in a file dift d_pick = 13: sub_readable_char_in_file 'read through a file by lines dift d_pick = 14: sub_read_file_by_lines 'look for duplicate fields between records dift d_pick = 15: sub_duplicate_fields 'count particular string in file dift d_pick = 17: sub_count_string_in_file 'remove duplicate records from a file dift d_pick = 18: sub_duplicate_records_remove 'Read a whole file into memory dift d_pick = 24: sub_file_read_lookup_lookat 'save part of a file into a new file dift d_pick = 25: sub_save_part_of_a_file 'zero divide to crash the program dift d_pick = 28: sub_zero_divide 'copy file to new file using fsip,fapp dift d_pick = 30: sub_copy_file_fsip_fapp 'uppercase or lowercase a file dift d_pick = 31: sub_file_to_upper_case 'to oldtoe a file dift d_pick = 32: sub_file_oldtoe 'hash a string dift d_pick = 41: sub_hash 'total characters in a file dift d_pick = 42: sub_file_total_characters sg_pass1 = s_pick sub_xyzmath ends sub_menu_files_and_chars subr sub_menu_proc_files 'updated 2007/03/09, 2007/03/08, 2005/08/31, 2005/04/18, 2004/01/11 vari s_any, d_any, s_dot, d_dot vari s_pick, d_pick, s_out, d_inp, s_xvalue $out "1 = count from a number to look for end of exact numbers" $out "2 = sub_file_to_fixed_length" $out "3 = sub_compare_two_files" $out "4 = lookup records of one file in another file" $out "41 = random Numbers" $out "42 = fibonacci numbers" $out "43 = factorial numbers by recursion" $out "44 = recursion speed test" $out "51 = key numbers" $inp s_pick, "enter number,* = end, x=" + dg_xvalue $isd d_any, s_pick d_pick = 0 dift d_any = 1: $tod d_pick, s_pick 'exact by count dift d_pick = 1: sub_exact_by_count 'make file fixed length dift d_pick = 2: sub_file_to_fixed_length 'compare two files dift d_pick = 3: sub_compare_two_files 'look up records of one file in another file dift d_pick = 4: sub_lookup_one_file_in_another_file 'Random numbers dift d_pick = 41: sub_random 'Fibonacci numbers dift d_pick = 42: sub_fibonacci 'Factorial numbers by recursion dift d_pick = 43: sub_factorial 'subroutine speed test using recursion dift d_pick = 44: sub_recursion_speed1 'Key numbers dift d_pick = 51: sub_tag_numbers sg_pass1 = s_pick sub_xyzmath ends sub_menu_proc_files subr sub_menu_numbers 'updated 2005/04/18, 2004/01/01 vari s_any, d_any, s_dot, d_dot vari s_pick, d_pick, s_out, d_inp, s_xvalue $out "44 = value of a string" $out "45 = sam bass" $out "46 = repeating decimals" $out "47 = figure interest every way" $out "48 = test $tod" $out "51 = doubling, powers of two" $out "53 = adding 1 to big numbers" $out "81 = build a very large string" $out "82 = double number math" $inp s_pick, "enter number,* = end, x=" + dg_xvalue $isd d_any, s_pick d_pick = 0 dift d_any = 1: $tod d_pick, s_pick 'value of a string dift d_pick = 44: sub_string_value 'sam bass dift d_pick = 45: sub_sam_bass 'repeating decimals dift d_pick = 46: sub_repeating_decimals 'figure interest every way dift d_pick = 47: sub_interest 'test $tod dift d_pick = 48: sub_test_stod 'Doubles dift d_pick = 51: sub_doubling dift d_pick = 53: sub_add_one 'build a large string dift d_pick = 81: sub_large_string 'double number math dift d_pick = 82: sub_double_math sg_pass1 = s_pick sub_xyzmath ends sub_menu_numbers subr sub_menu_floating_point 'updated 2003/09/14 vari s_pick, d_pick, d_any $out "1 = floating point cents .01 to .99" $out "2 = floating all cents" $out "3 = adding and rounding" $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 dift d_pick = 1: sub_floating_point_cents dift d_pick = 2: sub_floating_all_cents 'adding floating point numbers dift d_pick = 3: sub_adding_rounding ends sub_menu_floating_point subr sub_menu_programming 'updated 2008/01/10, 2005/02/28 vari s_pick, d_pick, d_any $out "1 = replace DIFT,$IFT to get rid of past colon command" $out "2 = indent Teapro program" $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 dift d_pick = 1: sub_teapro_dift_no_past_colon dift d_pick = 2: sub_prog_teapro_indent ends sub_menu_programming subr sub_count_string_in_file 'updated 2004/05/11 vari s_any, d_any, s_dot, d_dot, s_out vari s_filename, s_filedata, s_string, d_ctstring $inp s_filename, "enter filename" $inp s_string, "enter string not in quotes" $trb s_string, s_string finp s_filedata, s_filename $cnt d_ctstring, s_filedata, s_string $out "using $cnt" s_out = "count of '" + s_string + "' in " $app s_out, s_filename + " is=" + d_ctstring $inp s_any, s_out ends sub_count_string_in_file subr sub_save_part_of_a_file 'updated 2006/09/27 vari d_any, s_any, d_dot, s_dot vari s_filein, s_fileout, d_byte vari s_wholefile, s_part, d_long, d_beg vari d_loop1, d_loop2 vari d_process, d_seconds1, d_seconds2, d_good d_process = 1 dift d_process = 1 $inp s_filein, "enter the name of the input file" $ift s_filein = "*": dinc d_process endi dift d_process = 1 flen d_long, s_filein dsec d_seconds1 finp s_wholefile, s_filein dsec d_seconds2 d_any = d_seconds2 - d_seconds1 $out "seconds to read the file in=" + d_any $len d_long, s_wholefile ded$ s_any, d_long, 0, 0 $out "length of the whole file string=" + s_any endi d_loop1 = d_process dwhi d_loop1 = 1 d_good = 1 dift d_good = 1 d_beg = 0 $inp s_any, "enter beginning byte" $ift s_any = "*": dinc d_good $isd d_any, s_any dift d_any = 1: $tod d_beg, s_any endi dift d_good = 1 d_long = 0 $inp s_any, "enter length wanted" $ift s_any = "*": dinc d_good $isd d_any, s_any dift d_any = 1: $tod d_long, s_any endi dift d_good = 1 s_fileout = sg_nothing $inp s_any, "enter output filename" $ift s_any = "*": dinc d_good $len d_any, s_any dift d_any = 0: dinc d_good s_fileout = s_any endi dift d_good = 1 fdel d_any, s_fileout $out "beg=" + d_beg + ", long=" + d_long $cut s_part, s_wholefile, d_beg, d_long fout d_any, s_fileout, s_part dbad d_any = 0 s_any = "file=" + s_fileout + ", length=" + d_long $inp s_any, s_any $ift s_any = "*": dinc d_good endi d_loop1 = d_good endw ends sub_save_part_of_a_file subr sub_file_read_lookup_lookat 'updated 2008/02/10, 2006/10/05, 2006/09/27, 2002/07/10 'read a whole file into a string vari d_any, s_any, d_dot, s_dot vari s_filein, s_fileout, s_record, d_byte vari s_wholefile, d_length, d_long vari d_loop1, d_loop2, s_find, d_find vari d_count, d_line, s_rule vari s_pick, d_pick, d_process vari d_seconds1, d_seconds2, d_good, s_out, d_plines vari s_replace, d_replace, s_asterisks, s_quote $ch$ s_asterisks, "*", 76 dch$ s_quote, 34, 1 s_wholefile = sg_nothing s_rule = "1234567890" $app s_rule, s_rule $app s_rule, s_rule $app s_rule, s_rule d_process = 1 dift d_process = 1 $inp s_pick, "1 = read records, 2 = read in whole file" $ift s_pick = "*": dinc d_process $isd d_any, s_pick d_pick = 1 dift d_any = 1: $tod d_pick, s_pick endi dift d_process = 1 $inp s_filein, "enter the name of the file" $ift s_filein = "*": dinc d_process endi dift d_process = 1 flen d_length, s_filein dsec d_seconds1 dift d_pick = 1 d_byte = 1 dwhi d_byte <= d_length frea s_record, s_filein, d_byte, 4096 $app s_wholefile, s_record d_byte = d_byte + 4096 endw else finp s_wholefile, s_filein endi dsec d_seconds2 d_any = d_seconds2 - d_seconds1 $out "seconds to read the file in=" + d_any $len d_length, s_wholefile ded$ s_any, d_length, 0, 0 $out "length of the whole file string=" + s_any endi d_loop1 = d_process dwhi d_loop1 = 1 d_good = 1 s_any = "enter find string in double quotes or byte number" $inp s_find, s_any $ift s_find = "*" dinc d_good dinc d_loop1 endi dift d_good = 1 $trb s_find, s_find 'do we have a d_byte $isd d_any, s_find dift d_any = 1 $tod d_byte, s_find $cut s_record, s_wholefile, d_byte, 80 $out s_rule $out s_record dinc d_good endi endi dift d_good = 1 'do we have a left quote $cut s_any, s_find, 1, 1 $ift s_any <> s_quote: dinc d_good $off s_any, s_find, 1 $ift s_any <> s_quote: dinc d_good dift d_good <> 1: $out "bad quotes" endi dift d_good = 1 'we must begin and end with " = 34 in s_quote $par s_find, s_find, s_quote, 2 $len d_any, s_find dift d_any = 0 $out "string of zero length" dinc d_good endi endi dift d_good = 1 s_any = "if wanted, enter replacement" $app s_any, " string in double quotes" $inp s_replace, s_any 'do we have a left quote d_replace = 1 $trb s_replace, s_replace $cut s_any, s_replace, 1, 1 $ift s_any <> s_quote: dinc d_replace 'do we have a right quote $len d_any, s_replace $cut s_any, s_replace, d_any, 1 $ift s_any <> s_quote: dinc d_replace dift d_replace = 1 $out "before $par=" + s_replace $par s_replace, s_replace, s_quote, 2 $out " after $par=" + s_replace endi $len d_any, s_find $out "find=" + s_find + ", length=" + d_any $out s_asterisks s_out = "finding " + s_quote + s_find + s_quote $app s_out, " and beginning byte numbers" $app s_out, " in file=" + s_filein $out s_out dift d_replace = 1 s_out = "replacing with " + s_quote + s_replace $app s_out, s_quote $out s_out dsec d_any $swp s_wholefile, s_find, s_replace dsec d_dot d_any = d_dot - d_any $out "seconds to swap=" + d_any endi $out s_asterisks endi dift d_good = 1 d_count = 0 d_line = 0 d_plines = 0 d_find = 1 d_loop2 = 1 dwhi d_loop2 = 1 $lok d_find, s_wholefile, d_find, s_find dift d_find = 0 dinc d_loop2 else dinc d_count dinc d_line 'show and print the find below d_any = d_find - 10 $cut s_any, s_wholefile, d_any, 60 $bes s_any, s_any s_out = d_count + ". byte=" + d_find $app s_out, ": " + s_any $out s_out dift d_line > 15 d_line = 0 $inp s_any, "more, * to end" $ift s_any = "*": dinc d_loop2 endi dinc d_find endi endw endi endw dift d_process = 1 d_good = 2 $inp s_any, "1=output the file" $ift s_any = "1": d_good = 1 dift d_good = 1 $inp s_fileout, "enter the output filename" $ift s_fileout = "*": dinc d_good endi dift d_good = 1 $inp s_any, "1=blank all escapes in the file" $ift s_any = "*": dinc d_good $ift s_any = "1": $bes s_wholefile, s_wholefile endi dift d_good = 1 dsec d_seconds1 fout d_any, s_fileout, s_wholefile dbad d_any = 0 dsec d_seconds2 d_any = d_seconds2 - d_seconds1 $out "seconds to output the file=" + d_any $inp s_any, "return" endi endi ends sub_file_read_lookup_lookat subr sub_teapro_dift_no_past_colon 'updated 2006/05/24, 2005/02/28 vari s_any, d_any, s_dot, d_dot, s_out vari s_fileinp, s_fileout, s_record, d_filebyte vari d_process, d_loop, d_good, d_long, d_count vari d_colon, s_line, s_part1, s_part2, s_part3 vari s_indent, d_indent, d_lines, s_tab d_process = 1 $inp s_fileinp, "enter filename of program to fix" $inp s_fileout, "enter filename of fixed program" flen d_long, s_fileout dift d_long >= 0 $out "output file exists=" + s_fileout $inp s_any, "1=delete output file" $ift s_any = "1" fdel d_any, s_fileout else dinc d_process endi endi dch$ s_tab, 9, 1 d_filebyte = 1 d_lines = 0 d_count = 0 d_loop = d_process dwhi d_loop = 1 d_good = 1 fsip s_record, s_fileinp, d_filebyte dift d_filebyte = 0 dinc d_good dinc d_loop endi dift d_good = 1 'replace tab with 6 spaces $swp s_record, s_tab, " " 'do we have a dift,$ift $trb s_line, s_record $cut s_any, s_line, 1, 4 $cup s_any, s_any d_dot = 2 $ift s_any = "DIFT": d_dot = 1 $ift s_any = "$IFT": d_dot = 1 d_good = d_dot $lok d_colon, s_line, 1, ":" dift d_colon = 0: dinc d_good endi dift d_good = 1 'we have DIFT,$IFT and a colon but is it good 'break into s_part1,s_part2 d_any = d_colon - 1 $cut s_part1, s_line, 1, d_any d_any = d_colon + 1 $cut s_part2, s_line, d_any, 9999 'we have to have even counts of " and # in each $cnt d_any, s_part1, #"# d_any = d_any % 2 dift d_any <> 0: dinc d_good $cnt d_any, s_part2, #"# d_any = d_any % 2 dift d_any <> 0: dinc d_good $cnt d_any, s_part1, "#" d_any = d_any % 2 dift d_any <> 0: dinc d_good $cnt d_any, s_part2, "#" d_any = d_any % 2 dift d_any <> 0: dinc d_good endi dift d_good = 1 'we have one $trb s_part1, s_part1 $trb s_part2, s_part2 'get d_indent $trr s_line, s_record $len d_dot, s_line $trl s_line, s_line $len d_any, s_line d_indent = d_dot - d_any $ch$ s_indent, " ", d_indent 'prep the parts s_part1 = s_indent + s_part1 s_part2 = " " + s_indent + s_part2 s_part3 = s_indent + "endi" 'output the lines dinc d_count $out s_record fapp d_any, s_fileout, s_part1 dbad d_any = 0 fapp d_any, s_fileout, s_part2 dbad d_any = 0 fapp d_any, s_fileout, s_part3 dbad d_any = 0 d_lines = d_lines + 3 else 'output the uninteresting line fapp d_any, s_fileout, s_record dbad d_any = 0 dinc d_lines endi endw $inp s_any, "done count=" + d_count + ", lines=" + d_lines ends sub_teapro_dift_no_past_colon subr sub_floating_point_cents 'updated 2003/09/14 vari s_any, d_any, s_dot, d_dot, s_out vari d_money, d_loop, d_count d_money = 0 $inp s_any, "enter whole dollars to begin" $isd d_any, s_any dift d_any = 1: $tod d_money, s_any d_money = d_money * 100 d_count = 0 d_loop = 1 dwhi d_loop = 1 d_any = d_money / 100 $out d_any dinc d_count d_any = d_count % 20 dift d_any = 0: $inp s_any, "more" dinc d_money dift d_count > 99: dinc d_loop endw $inp s_any, "done" ends sub_floating_point_cents subr sub_floating_all_cents 'updated 2003/09/14 vari s_any, d_any, s_dot, d_dot, s_out vari d_total, d_roundtot, d_loop, d_count, d_maxcount vari d_cents, d_dollars d_maxcount = 1000 $inp s_any, "how many times each" $isd d_any, s_any dift d_any = 1: $tod d_maxcount, s_any d_total = 0 d_roundtot = 0 d_count = 0 d_cents = 1 d_dollars = d_cents / 100 d_loop = 1 dwhi d_loop = 1 d_total = d_total + d_dollars d_roundtot = d_roundtot + d_dollars d_roundtot = d_roundtot * 100 drou d_roundtot, d_roundtot d_roundtot = d_roundtot / 100 dinc d_count dift d_count >= d_maxcount s_out = "count=" + d_count $app s_out, ", total=" + d_total $app s_out, ", roundtot=" + d_roundtot $app s_out, ", cents=" + d_cents $out s_out d_count = 0 d_total = 0 d_roundtot = 0 dinc d_cents dift d_cents >= 100: dinc d_loop d_dollars = d_cents / 100 d_any = d_cents % 20 dift d_any = 0: $inp s_any, "more" endi endw $inp s_any, "done" ends sub_floating_all_cents subr sub_duplicate_records_remove 'updated 2006/08/07, 2002/02/19 vari s_any, d_any, s_dot, d_dot vari s_oldrecord, s_newrecord vari s_oldestrecord, s_newfield, d_totcount, d_seecount vari d_loop, d_good, d_process, d_showskipped vari s_inpfilename, s_outfilename, d_filebyte vari d_ctall, d_ctgood, d_ctskipped d_process = 1 dift d_process = 1 $inp s_inpfilename, "enter input filename" $ift s_inpfilename = "*": dinc d_process endi dift d_process = 1 $inp s_outfilename, "enter output filename" $ift s_outfilename = "*": dinc d_process endi dift d_process = 1 flen d_any, s_outfilename dift d_any >= 0 $inp s_any, "1=purge file=" + s_outfilename $ift s_any = "*": dinc d_process $ift s_any = "1" fdel d_any, s_outfilename dift d_any <> 1 $out "cannot delete" dinc d_process endi endi endi endi dift d_process = 1 d_showskipped = 2 $inp s_any, "1=show duplicates" $ift s_any = "*": dinc d_process $ift s_any = "1": d_showskipped = 1 endi d_ctall = 0 d_ctgood = 0 d_ctskipped = 0 d_good = 2 d_filebyte = 1 d_loop = d_process dwhi d_loop = 1 dinc d_ctall d_any = d_ctall % 100 dift d_any = 0: $sho "record=" + d_ctall s_oldrecord = s_newrecord 'sip in a record starting at d_filebyte fsip s_newrecord, s_inpfilename, d_filebyte dift d_filebyte > 0 $ift s_newrecord <> s_oldrecord dift d_ctall > 1 'output old if diff and new not the first dinc d_ctgood fapp d_any, s_outfilename, s_oldrecord dbad d_any < 2 endi else dift d_showskipped = 1 $out d_ctall + " " + s_oldrecord $out d_ctall + " " + s_newrecord endi dinc d_ctskipped endi else dinc d_ctgood fapp d_any, s_outfilename, s_oldrecord dbad d_any < 2 dinc d_loop endi endw s_any = "total=" + d_ctall + ", good=" + d_ctgood $app s_any, ", skipped=" + d_ctskipped $inp s_any, s_any ends sub_duplicate_records_remove subr sub_duplicate_fields 'updated 2002/02/19 vari s_any, d_any, s_dot, d_dot vari s_oldrecord, s_newrecord, s_filename, d_filebyte vari s_oldfield, s_newfield, d_totcount, d_seecount vari d_begin, d_length, d_loop, d_good d_good = 1 $inp s_filename, "enter file name" $inp s_any, "enter field beginning position" $isd d_any, s_any dift d_any <> 1 dinc d_good $out "bad beginning position" else $tod d_begin, s_any endi $inp s_any, "enter field length" dift d_any <> 1 dinc d_good $out "bad field length" else $tod d_length, s_any endi d_seecount = 0 d_totcount = 0 s_newfield = sg_nothing d_filebyte = 1 d_loop = d_good dwhi d_loop = 1 d_any = d_totcount % 1000 dift d_any = 0: $sho "record=" + d_totcount s_oldfield = s_newfield fsip s_newrecord, s_filename, d_filebyte dift d_filebyte > 0 dinc d_totcount $cut s_newfield, s_newrecord, d_begin, d_length $ift s_newfield = s_oldfield $out s_newrecord dinc d_seecount endi else dinc d_loop endi endw $inp s_any, "total count=" + d_totcount + ", same=" + d_seecount ends sub_duplicate_fields subr sub_interest 'updated 2005/09/05, 2001/11/27 'interest in every way vari s_any, d_any, s_dot, d_dot vari d_loop, d_good, d_process, s_out, s_inp vari s_dashes, d_yescount, d_mult, d_periodrate vari d_begmoney, d_yearrate, d_periodsper vari d_periodcount, d_payment, d_endmoney vari d_which vari d_holdbegmoney, d_holdyearrate, d_holdperiodsper vari d_holdperiodcount, d_holdpayment, d_holdendmoney vari d_holdwhich $ch$ s_dashes, "-", 76 d_holdbegmoney = 0 d_holdyearrate = 75 / 1000 d_holdperiodsper = 12 d_holdperiodcount = 60 d_holdpayment = 0 d_holdendmoney = 0 d_holdwhich = 6 d_begmoney = 0 d_yearrate = 75 / 1000 d_periodsper = 12 d_periodcount = 60 d_payment = 0 d_endmoney = 0 d_which = 6 d_loop=1 dwhi d_loop=1 $out s_dashes $out "if beginning money < 0 then we have a loan" $out "1. beginning money = " + d_begmoney $out "2. year rate = " + d_yearrate $out "3. periods per year = " + d_periodsper $out "4. period count = " + d_periodcount $out "5. payment amount = " + d_payment $out "6. ending money = " + d_endmoney $out "find=" + d_which $out s_dashes d_process = 1 dift d_process = 1 d_begmoney = d_holdbegmoney d_yearrate = d_holdyearrate d_periodsper = d_holdperiodsper d_periodcount = d_holdperiodcount d_payment = d_holdpayment d_endmoney = d_holdendmoney d_which = d_holdwhich endi dift d_process = 1 $inp s_inp, "enter which to find = " + d_which $ift s_inp = "*": dinc d_process $isd d_any, s_inp dift d_any = 1: $tod d_which, s_inp endi dift d_process = 1 $out "make beginning money < 0 for payments to a loan" $inp s_inp, "enter beginning money = " + d_begmoney $ift s_inp = "*": dinc d_process $isd d_any, s_inp dift d_any = 1: $tod d_begmoney, s_inp endi dift d_process = 1 $inp s_inp, "enter year rate = " + d_yearrate $ift s_inp = "*": dinc d_process $isd d_any, s_inp dift d_any = 1: $tod d_yearrate, s_inp endi dift d_process = 1 $inp s_inp, "enter periods per year = " + d_periodsper $ift s_inp = "*": dinc d_process $isd d_any, s_inp dift d_any = 1: $tod d_periodsper, s_inp endi dift d_process = 1 $inp s_inp, "enter period count = " + d_periodcount $ift s_inp = "*": dinc d_process $isd d_any, s_inp dift d_any = 1: $tod d_periodcount, s_inp endi dift d_process = 1 $inp s_inp, "enter payment amount = " + d_payment $ift s_inp = "*": dinc d_process $isd d_any, s_inp dift d_any = 1: $tod d_payment, s_inp endi dift d_process = 1 $inp s_inp, "enter ending money = " + d_endmoney $ift s_inp = "*": dinc d_process $isd d_any, s_inp dift d_any = 1: $tod d_endmoney, s_inp endi d_loop = d_process dift d_process = 1 d_holdbegmoney = d_begmoney d_holdyearrate = d_yearrate d_holdperiodsper = d_periodsper d_holdperiodcount = d_periodcount d_holdpayment = d_payment d_holdendmoney = d_endmoney d_holdwhich = d_which endi dift d_process = 1 'find d_endmoney d_yescount = 0 dift d_begmoney > 0: dinc d_yescount dift d_yearrate > 0: dinc d_yescount dift d_periodsper > 0: dinc d_yescount dift d_periodcount > 0: dinc d_yescount dift d_payment = 0: dinc d_yescount dift d_endmoney = 0: dinc d_yescount dift d_which = 6: dinc d_yescount dift d_yescount = 7 'get d_periodrate d_periodrate = d_yearrate / d_periodsper 'get the multiplier d_any = d_periodrate + 1 dpow d_mult, d_any, d_periodcount d_endmoney = d_begmoney * d_mult dinc d_process endi endi dift d_process = 1 'find d_begmoney d_yescount = 0 dift d_begmoney = 0: dinc d_yescount dift d_yearrate > 0: dinc d_yescount dift d_periodsper > 0: dinc d_yescount dift d_periodcount > 0: dinc d_yescount dift d_payment = 0: dinc d_yescount dift d_endmoney > 0: dinc d_yescount dift d_which = 1: dinc d_yescount dift d_yescount = 7 'get d_periodrate d_periodrate = d_yearrate / d_periodsper 'get the multiplier d_any = d_periodrate + 1 dpow d_mult, d_any, d_periodcount d_begmoney = d_endmoney / d_mult dinc d_process endi endi dift d_process = 1 'find d_payment with d_begmoney = 0 d_yescount = 0 dift d_begmoney = 0: dinc d_yescount dift d_yearrate > 0: dinc d_yescount dift d_periodsper > 0: dinc d_yescount dift d_periodcount > 0: dinc d_yescount dift d_payment = 0: dinc d_yescount dift d_endmoney > 0: dinc d_yescount dift d_which = 5: dinc d_yescount dift d_yescount = 7 'get d_periodrate d_periodrate = d_yearrate / d_periodsper 'get the multiplier d_any = d_periodrate + 1 dpow d_mult, d_any, d_periodcount ddec d_mult d_payment = d_endmoney * d_periodrate / d_mult dinc d_process endi endi dift d_process = 1 'find d_payment with negative d_begmoney = loan d_yescount = 0 dift d_begmoney < 0: dinc d_yescount dift d_yearrate > 0: dinc d_yescount dift d_periodsper > 0: dinc d_yescount dift d_periodcount > 0: dinc d_yescount dift d_payment = 0: dinc d_yescount dift d_endmoney = 0: dinc d_yescount dift d_which = 5: dinc d_yescount dift d_yescount = 7 'get d_periodrate d_periodrate = d_yearrate / d_periodsper 'get the multiplier d_any = d_periodrate + 1 dpow d_mult, d_any, d_periodcount d_any = d_mult - 1 d_dot = - d_begmoney d_payment = d_dot * d_periodrate * d_mult / d_any dinc d_process endi endi endw ends sub_interest subr sub_read_file_by_lines 'updated 2001/11/27 vari s_any, d_any, s_dot, d_dot vari s_filename, d_filebyte, s_record vari d_loop1, d_loop2, d_process, d_linecount vari d_good, s_input, s_dashes $ch$ s_dashes, "-", 76 d_process = 1 $inp s_filename, "enter the filename, * to end" $ift s_filename = "*": dinc d_process $out s_dashes d_linecount = 0 d_filebyte = 1 d_loop1 = d_process dwhi d_loop1 = 1 d_good = 1 fsip s_record, s_filename, d_filebyte $len d_any, s_record dift d_any = 0: dinc d_good dift d_good = 1 d_loop2 = 1 dwhi d_loop2 = 1 $cut s_dot, s_record, 1, 70 $cut s_record, s_record, 71, 99999 dinc d_linecount dift d_linecount > 20 $inp s_any, "more to this line" endi $out s_dot $len d_any, s_record dift d_any = 0: dinc d_loop2 endw endi dift d_linecount >= 20 $out s_dashes d_linecount = 0 $out "filename=" + s_filename + ", byte=" + d_filebyte $inp s_input, "return or enter line number, * to end" $isd d_any, s_input dift d_any = 1: $tod d_filebyte, s_input $ift s_input = "*": dinc d_loop1 $out s_dashes endi dift d_filebyte = 0: dinc d_loop1 endw $inp s_any, "end of file" ends sub_read_file_by_lines subr sub_repeating_decimals 'updated 2002/05/10 'prime numbers whose reciprocals repeat every five 'A person had this on a special math test on 29-OCT-2001 'A person missed this one but made the highest 'score in the school vari d_any, s_any, d_dot, s_dot vari s_number, d_number, d_loop, s_five1, s_five2 vari d_show, s_out d_show = 2 $inp s_any, "1=show only answers" $ift s_any = "1": d_show = 1 d_number = 1 d_loop = 1 dwhi d_loop = 1 dift d_show <> 1: $out d_number d_any = 1 / d_number dto$ s_number, d_any, 0, 0 $lok d_dot, s_number, 1, "." dift d_dot > 0 dinc d_dot $cut s_five1, s_number, d_dot, 5 d_dot = d_dot + 5 $cut s_five2, s_number, d_dot, 5 $ift s_five1 = s_five2 s_out = "number=" + d_number + ", reciprocal=" + s_number dfac d_any, d_number dift d_any = 1: $app s_out, " prime" $out s_out dift d_show <> 1: $inp s_any, "return" endi endi dinc d_number dpow d_any, 10, 5 dift d_number > d_any: dinc d_loop endw $inp s_any, "done" ends sub_repeating_decimals subr sub_file_to_fixed_length 'updated 2001/10/06 vari d_any, s_any, d_dot, s_dot vari s_file1, s_record, d_filebyte vari s_file2, s_blanks, d_long, d_tell vari d_loop, s_endchar, d_length $inp s_file1, "name of file1" $inp s_file2, "name of file2" d_length = 80 $inp s_any, "length to make records, counting to ending byte" $isd d_any, s_any dift d_any = 1: $tod d_length, s_any $inp s_endchar, "character to put in last byte end of records" d_long = d_length - 1 $ch$ s_blanks, " ", 1000 d_tell = 0 d_filebyte = 1 d_loop = 1 dwhi d_loop = 1 dinc d_tell d_any = d_tell % 100 dift d_any = 0: $sho "record=" + d_tell fsip s_record, s_file1, d_filebyte dift d_filebyte > 0 $app s_record, s_blanks $cut s_record, s_record, 1, d_long $app s_record, s_endchar fapp d_any, s_file2, s_record else dinc d_loop endi endw $inp s_any, "done" ends sub_file_to_fixed_length subr sub_zero_divide 'updated 2000/12/15 vari d_any, s_any, d_dot, s_dot d_dot = 0 d_any = 1944 / d_dot ends sub_zero_divide subr sub_floating_point_test 'updated 2005/04/19, 2004/09/25 vari d_any, s_any, d_dot, s_dot, s_out dpow d_any, 10, 15 d_any = d_any / 3 ded$ s_out, d_any, 0, 0 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_exact_by_count 'updated 2005/09/05, 2000/12/15 vari d_any, s_any, d_dot, s_dot vari d_number, d_loop, d_count, d_many $inp s_any, "Enter the beginning number to count from" $tod d_number, s_any $tod d_many, "999999" d_count = 0 d_loop = 1 dwhi d_loop = 1 dift d_count > d_many d_count = 0 ded$ s_any, d_number, 20, 20 $out "Exact by count = " + s_any endi dinc d_count dinc d_number endw ends sub_exact_by_count subr sub_char_in_file 'updated 2005/11/30, 2005/04/19, 2005/02/10, 2001/12/28 'show characters in a file vari d_any, s_any, d_dot, s_dot, s_out vari s_record, d_byte, s_file, d_loop, d_char, s_char vari d_length, d_long, s_show, d_lenfile vari d_column, d_prevchar, s_dashes $inp s_file, "enter the filename" $cup s_file, s_file flen d_lenfile, s_file $ch$ s_dashes, "-", 76 d_prevchar = 0 d_length = 20 d_column = 0 d_byte = 1 d_loop = 1 dwhi d_loop = 1 frea s_record, s_file, d_byte, d_length $len d_long, s_record dift d_long > 0 s_show = sg_nothing d_dot = 1 dwhi d_dot <= d_long d_prevchar = d_char $cut s_char, s_record, d_dot, 1 $chd d_char, s_char dinc d_column dift d_char < 32 s_char = "esc" d_column = 0 endi dift d_char > 126 s_char = "esc" d_column = 0 endi 's_show will show the non escapes at the bottom $ift s_char <> "esc": $app s_show, s_char d_any = d_byte + d_dot - 1 dto$ s_any, d_any, 9, 0 s_out = "file byte=" + s_any dto$ s_any, d_column, 5, 0 $app s_out, " column =" + s_any $app s_out, " char = " + "'" + s_char + "'" dto$ s_any, d_char, 3, 0 $app s_out, " " + s_any $out s_out dift d_char = 10: $out s_dashes dinc d_dot endw $out s_show else dinc d_loop endi s_out = "* to end, or enter byte number, file=" + s_file $app s_out, ", length=" + d_lenfile $inp s_any, s_out $ift s_any = "*": dinc d_loop $isd d_any, s_any dift d_any = 1 $tod d_byte, s_any d_column = 0 else d_byte = d_byte + d_length endi endw ends sub_char_in_file subr sub_readable_char_in_file 'updated 2002/11/17 'show characters in a file vari d_any, s_any, d_dot, s_dot vari s_record, d_byte, s_file, d_loop, d_char, s_char vari d_length, d_long, s_show, d_count, d_line, s_1310 $inp s_file, "enter the filename" dch$ s_any, 13, 1 dch$ s_dot, 10, 1 s_1310 = s_any + s_dot d_line = 0 d_count = 0 s_show = sg_nothing d_length = 20 d_byte = 1 d_loop = 1 dwhi d_loop = 1 frea s_record, s_file, d_byte, d_length $len d_long, s_record dift d_long > 0 d_dot = 1 dwhi d_dot <= d_long $cut s_char, s_record, d_dot, 1 $chd d_char, s_char dift d_char > 32 dift d_char <= 126 $app s_show, s_char dinc d_count dift d_count >= 70 $out s_show s_show = sg_nothing d_count = 0 dinc d_line endi endi endi dinc d_dot endw else dinc d_loop endi dift d_line >= 5 $out s_show s_show = sg_nothing d_line = 0 $inp s_any, d_byte + ", more, * to end" $ift s_any = "*": dinc d_loop endi d_byte = d_byte + d_long endw $inp s_any, "end" ends sub_readable_char_in_file subr sub_copy_file_fsip_fapp 'updated 2001/08/28 'copy file using fsip,fapp vari d_any, s_any, d_dot, s_dot vari s_file1, s_file2, d_byte, s_line $inp s_file1, "enter name of file to copy from" $inp s_file2, "enter name of file to copy to" d_byte = 1 dwhi d_byte > 0 fsip s_line, s_file1, d_byte dift d_byte > 0 $out s_line $out "byte=" + d_byte fapp d_any, s_file2, s_line endi endw $inp s_any, "done" ends sub_copy_file_fsip_fapp subr sub_file_to_upper_case 'updated 2006/04/13 'uppercase or lowercase a file vari d_any, s_any, d_dot, s_dot vari s_file1, s_file2, d_byte, s_line, d_upper, d_process d_process = 1 dift d_process = 1 $inp s_file1, "enter name of file to copy from" $ift s_file1 = "*": dinc d_process endi dift d_process = 1 $inp s_file2, "enter name of file to copy to" $ift s_file2 = "*": dinc d_process endi dift d_process = 1 $inp s_any, "1=uppercase, 2=lowercase" $ift s_any = "*": dinc d_process d_upper = 1 $ift s_any <> "1": dinc d_upper endi dift d_process = 1 finp s_line, s_file1 $cup s_line, s_line fout d_any, s_file2, s_line dbad d_any = 0 $inp s_any, "done" endi ends sub_file_to_upper_case subr sub_file_oldtoe 'updated 2009/05/20, 2006/04/08, 2006/03/17, 2006/03/16 vari d_any, s_any, d_dot, s_dot, s_out vari d_long, d_loop, d_byte, s_line1, s_line2, d_seconds vari s_char, d_char, s_file1, s_file2, d_process vari s_key, d_which d_process = 1 dift d_process = 1 $inp s_file1, "enter input file name" $ift s_file1 = "*": dinc d_process endi dift d_process = 1 $inp s_file2, "enter output file name" $ift s_file2 = "*": dinc d_process endi dift d_process = 1 $inp s_key, "enter a word" $ift s_key = "*": dinc d_process endi dift d_process = 1 d_which = 1 $inp s_any, "1=into, 2=out of" $ift s_any = "*": dinc d_process $ift s_any = "2": d_which = 2 endi dift d_process = 1 dsec d_seconds finp s_line1, s_file1 $len d_long, s_line1 fdel d_any, s_file2 $toe s_line2, s_line1, s_key, d_which fout d_any, s_file2, s_line2 dbad d_any = 0 dsec d_any d_seconds = d_any - d_seconds $inp s_any, "done, length=" + d_long + ", sec=" + d_seconds endi ends sub_file_oldtoe subr sub_factorial 'updated 2000/12/15 'find factorial numbers by recursion vari d_any, s_any, d_dot, s_dot vari d_number, d_factorial $inp s_any, "enter number to find factorial of" $isd d_any, s_any dift d_any = 1 $tod d_number, s_any dg_pass1 = d_number sub_findfactorial d_factorial = dg_pass1 $inp s_any,"The factorial of " + d_number + " is " + d_factorial endi ends sub_factorial subr sub_findfactorial 'updated 2000/12/15 vari d_any, s_any, d_dot, s_dot vari d_factorial, d_number d_number = dg_pass1 dift d_number > 1 d_any = d_number - 1 dg_pass1 = d_any sub_findfactorial d_any = dg_pass1 d_factorial = d_number * d_any else d_factorial = 1 $inp s_any, "at bottom" endi $out d_factorial dg_pass1 = d_factorial ends sub_findfactorial subr sub_recursion_speed1 'updated 2000/12/15 'test speed of calling a subroutine using recursion vari d_any, s_any, d_dot, s_dot vari d_time, d_count, d_howmany dg_pass2 = 200 $inp s_any, "How deep the recursion, default = 200" $isd d_any, s_any dift d_any = 1: $tod dg_pass2, s_any d_howmany = 1 $inp s_any, "How many times to call the recursion?" $isd d_any, s_any dift d_any = 1: $tod d_howmany, s_any dg_pass3 = 2 $inp s_any, "1 = stop at bottom" $ift s_any = "1": dg_pass3 = 1 dg_pass4 = 2 $inp s_any, "1 = show count going into" $ift s_any = "1": dg_pass4 = 1 dsec d_time d_count = 0 dwhi d_count < d_howmany dg_pass1 = 0 sub_recursion_speed2 d_dot = dg_pass1 dinc d_count endw dsec d_any d_time = d_any - d_time $out "Time = " + d_time $out "total=" + d_dot $inp s_any, "return" ends sub_recursion_speed1 subr sub_recursion_speed2 'updated 2000/12/15 'test speed of calling a subroutine using recursion vari d_any, s_any d_any = dg_pass1 dinc d_any s_any = "recursion=" + d_any + " to " + dg_pass2 dift dg_pass4 = 1: $out d_any dift d_any < dg_pass2 dg_pass1 = d_any sub_recursion_speed2 d_any = dg_pass1 else dift dg_pass3 = 1 'stop at the bottom $inp s_any, "bottom at " + d_any endi endi dg_pass1 = d_any ends sub_recursion_speed2 subr sub_string_value 'updated 2000/12/15 vari d_any, s_any, d_dot, s_dot, d_pat, s_pat vari s_string, d_value, d_long $inp s_string, "enter the string to find the value of" $trb s_string, s_string $cup s_string, s_string $len d_long, s_string d_dot = 1 dwhi d_dot <= d_long $cut s_dot, s_string, d_dot, 1 $ift s_dot < "A" $del s_string, d_dot, 1 ddec d_long ddec d_dot else $ift s_dot > "Z" $del s_string, d_dot, 1 ddec d_long ddec d_dot endi endi dinc d_dot endw $cut s_string, s_string, 1, 10 $len d_long, s_string d_value = 0 d_dot = 1 dwhi d_dot <= d_long $cut s_dot, s_string, d_dot, 1 $chd d_any, s_dot d_value = d_any * d_any * d_dot * d_dot + d_value dinc d_dot endw $inp s_any, "The value of the string " + s_string + ", is=" + d_value ends sub_string_value subr sub_characters 'updated 2005/10/12, 2000/12/15 vari d_any, s_any, d_dot, s_dot, s_out vari s_char, d_char, d_beg, d_end, s_pick vari d_yesfile, s_file, s_number d_beg = 32 d_end = 128 s_out = "1=chars 0/31, 2=chars 32/128, 3=chars 129/193" $app s_out, ", 4=chars 194/255" $inp s_pick, s_out $ift s_pick = "1" d_beg = 0 d_end = 31 endi $ift s_pick = "2" d_beg = 32 d_end = 128 endi $ift s_pick = "3" d_beg = 129 d_end = 193 endi $ift s_pick = "4" d_beg = 194 d_end = 255 endi d_yesfile = 2 $inp s_any, "1=output to a file" $ift s_any = "1" $inp s_file, "enter filename" d_yesfile = 1 endi s_dot = sg_nothing d_dot = 0 d_char = d_beg dwhi d_char <= d_end dch$ s_char, d_char, 1 dto$ s_number, d_char, 3, 0 s_out = s_number + "='" + s_char + "'" dift d_yesfile = 1 fapp d_any, s_file, s_out dbad d_any = 0 endi $app s_dot, " " + s_out dinc d_dot dift d_dot >= 6 $out s_dot d_dot = 0 s_dot = sg_nothing endi dinc d_char endw $len d_any, s_dot dift d_any > 0: $out s_dot $inp s_any, "return" ends sub_characters subr sub_compare_two_files 'updated 2007/03/09, 2007/03/08, 2006/04/04, 2006/04/02, 2000/12/15 'compare two files vari d_any, s_any, d_dot, s_dot vari s_file1, s_file2, d_byte, d_loop vari s_line1, s_line2, d_grab, d_long vari s_numbers, d_process, d_ctrec vari d_tap, s_tap1, s_tap2 d_process = 1 s_numbers = "1234567890123456789012345678901234567890" $app s_numbers, s_numbers $cut s_numbers, s_numbers, 1, 70 dift d_process = 1 $inp s_file1, "enter the name of file1" $ift s_file1 = "*": dinc d_process endi dift d_process = 1 $inp s_file2, "enter the name of file2" $ift s_file2 = "*": dinc d_process endi dift d_process = 1 d_grab = 70 $inp s_any, "enter record length including crlf" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod d_grab, s_any endi d_ctrec = 0 d_byte = 1 d_loop = d_process dwhi d_loop = 1 dinc d_ctrec s_line1 = sg_nothing s_line2 = sg_nothing frea s_line1, s_file1, d_byte, d_grab frea s_line2, s_file2, d_byte, d_grab $len d_long, s_line1 dift d_long > 0 $ift s_line1 = s_line2 $out "OK record compare=" + d_ctrec else $out "different record=" + d_ctrec d_dot = 1 d_tap = 1 dwhi d_tap <= d_long $cut s_tap1, s_line1, d_tap, 1 $cut s_tap2, s_line2, d_tap, 1 $ift s_tap1 <> s_tap2 d_dot = d_tap d_tap = d_long endi dinc d_tap endw $out "difference after byte=" + d_dot $out s_file1 + "=" d_dot = 1 dwhi d_dot <= d_grab $cut s_any, s_line1, d_dot, 70 $out s_any d_dot = d_dot + 70 endw $out s_numbers $out s_file2 + "=" d_dot = 1 dwhi d_dot < d_grab $cut s_any, s_line2, d_dot, 70 $out s_any d_dot = d_dot + 70 endw $out s_numbers $inp s_any, "difference above, * to end" $ift s_any = "*": dinc d_loop endi else dinc d_loop endi d_byte = d_byte + d_grab endw $inp s_any, "done" ends sub_compare_two_files subr sub_lookup_one_file_in_another_file 'updated 2005/11/02 '2005/10/19, 2005/10/14, 2005/10/03, 2005/09/06, 2005/08/31 vari d_any, s_any, d_dot, s_dot vari s_filename1, s_filename2 vari s_filedata1, s_filedata2 vari d_byte, d_good, d_loop, d_process, d_filebyte1 vari s_record1, d_showfinds, d_long, d_ctfind, d_ctnofind vari d_tofile, s_tofilename, d_special, s_lookfor vari d_fieldbeg, d_fieldlong, d_onlyfield vari d_showlookfor d_process = 1 dift d_process = 1 $out "to lookup filename1 records in filename2 records" $inp s_filename1, "enter filename1" $ift s_filename1 = "*": dinc d_process endi dift d_process = 1 $inp s_filename2, "enter filename2" $ift s_filename2 = "*": dinc d_process endi dift d_process = 1 flen d_any, s_filename1 $out "filename1=" + s_filename1 + ", length=" + d_any finp s_filedata2, s_filename2 $len d_long, s_filedata2 $out "filename2=" + s_filename2 + ", length=" + d_long d_showfinds = 1 $inp s_any, "1=showfinds, 2=show not finds" $ift s_any = "2": d_showfinds = 2 $ift s_any = "*": dinc d_process endi dift d_process = 1 d_tofile = 2 $inp s_any, "1=results to a tofile" $ift s_any = "*": dinc d_process $ift s_any = "1" d_tofile = 1 $inp s_tofilename, "enter tofile name" $ift s_any = "*": dinc d_process flen d_any, s_tofilename dift d_any >= 0 $inp s_any, "1=purge tofile=" + s_tofilename $ift s_any = "1": fdel d_any, s_tofilename $ift s_any = "*": dinc d_process endi endi endi dift d_process = 1 d_special = 0 $out "special handling of file1 record" $out "1=file1 has ssn in position 5 remove -" $out "2=file1 has ssn in position 5 leave -" $out "3=enter beg byte and length of field" $out "4=enter beg byte and length, remove - in lookfor" $inp s_any, "enter a number" $ift s_any = "*": dinc d_process $ift s_any = "1": d_special = 1 $ift s_any = "2": d_special = 2 $ift s_any = "3": d_special = 3 $ift s_any = "4": d_special = 4 dift d_special = 3 d_fieldbeg = 0 d_fieldlong = 0 $inp s_any, "enter beginning byte of field" $tod d_fieldbeg, s_any $inp s_any, "enter length of field" $tod d_fieldlong, s_any endi dift d_special = 4 d_fieldbeg = 0 d_fieldlong = 0 $inp s_any, "enter beginning byte of field" $tod d_fieldbeg, s_any $inp s_any, "enter length of field" $tod d_fieldlong, s_any endi d_onlyfield = 2 $inp s_any, "1=output only the field" $ift s_any = "1": d_onlyfield = 1 endi d_showlookfor = 2 dift d_process = 1 $inp s_any, "1=show each s_lookfor field" $ift s_any = "1": d_showlookfor = 1 endi d_ctfind = 0 d_ctnofind = 0 d_filebyte1 = 1 d_loop = d_process dwhi d_loop = 1 d_good = 1 fsip s_record1, s_filename1, d_filebyte1 dift d_filebyte1 = 0 dinc d_good dinc d_loop endi dift d_good = 1 dift d_special = 0: s_lookfor = s_record1 dift d_special = 1 'ssn in position 5 $par s_lookfor, s_record1, ",", 5 $swp s_lookfor, "-", "" endi dift d_special = 2 'ssn in position 5 leave in - $par s_lookfor, s_record1, ",", 5 endi dift d_special = 3 'beginning byte in d_fieldbeg, long in d_fieldlong $cut s_lookfor, s_record1, d_fieldbeg, d_fieldlong endi dift d_special = 4 'beginning byte in d_fieldbeg, long in d_fieldlong 'remove - in s_lookfor $cut s_lookfor, s_record1, d_fieldbeg, d_fieldlong $swp s_lookfor, "-", sg_nothing endi endi dift d_good = 1 $trb s_lookfor, s_lookfor $len d_any, s_lookfor dift d_any = 0: dinc d_good endi dift d_good = 1 dift d_showlookfor = 1 $out "looking for='" + s_lookfor + "'" endi $lok d_byte, s_filedata2, 1, s_lookfor dift d_showfinds = 1 dift d_byte > 0 dinc d_ctfind $out "found=" + s_record1 dift d_onlyfield = 1 $cut s_record1, s_record1, d_fieldbeg, d_fieldlong endi dift d_tofile = 1 fapp d_any, s_tofilename, s_record1 dbad d_any = 0 endi else dinc d_ctnofind endi else dift d_byte = 0 dinc d_ctnofind $out "no find=" + s_record1 dift d_onlyfield = 1 $cut s_record1, s_record1, d_fieldbeg, d_fieldlong endi dift d_tofile = 1 fapp d_any, s_tofilename, s_record1 dbad d_any = 0 endi else dinc d_ctfind endi endi endi endw $out "find count=" + d_ctfind + ", no find=" + d_ctnofind $inp s_any, "done" ends sub_lookup_one_file_in_another_file subr sub_random 'updated 2000/12/15 'random numbers vari d_randh1, d_randh2, d_rand1, d_rand2, d_max, d_min vari d_gen, d_mult, d_add, d_mod1, d_mod2 vari d_loop, d_count, d_tell vari s_num1, s_num2, s_num3, s_num4, s_num5, s_num6 '3,17 did 458052 '3,19 did 672311 '3,23 did 1349393 $tod d_gen, "123456791" $tod d_mult, "3" $tod d_add, "23" $tod d_mod1, "123456791" $tod d_mod2, "1000000" d_randh1 = 0 d_randh2 = 0 d_rand1 = 0 d_rand2 = 0 d_min = 10000 * 10000 d_max = - 10000 * 10000 d_count = 1 d_loop = 1 dwhi d_loop = 1 d_rand2 = d_rand1 d_gen = d_gen + d_add * d_mult d_gen = d_gen % d_mod1 d_rand1 = d_gen % d_mod2 dift d_count > 1000 dift d_max < d_rand1: d_max = d_rand1 dift d_min > d_rand1: d_min = d_rand1 d_tell = d_count % 10000 dift d_tell = 0 dto$ s_num1, d_count, 9, 0 dto$ s_num2, d_min, 9, 0 dto$ s_num3, d_max, 9, 0 dto$ s_num4, d_randh2, 9, 0 dto$ s_num5, d_randh1, 9, 0 dto$ s_num6, d_rand1, 9, 0 $out s_num1+s_num2+s_num3+s_num4+s_num5+s_num6 endi endi dift d_rand1 = d_randh1 dift d_rand2 = d_randh2: dinc d_loop endi dift d_count = 1000 d_randh1 = d_rand1 d_randh2 = d_rand2 endi dinc d_count endw dto$ s_num1, d_count, 9, 0 dto$ s_num2, d_min, 9, 0 dto$ s_num3, d_max, 9, 0 dto$ s_num4, d_randh2, 9, 0 dto$ s_num5, d_randh1, 9, 0 dto$ s_num6, d_rand1, 9, 0 $out s_num1 + s_num2 + s_num3 + s_num4 + s_num5 + s_num6 $inp s_num1, "return" ends 'sub_random subr sub_fibonacci 'updated 2000/12/15 'find fibonacci numbers vari d_any, s_any, d_dot, s_dot vari d_count, d_num1, d_num2, d_ratio, d_loop, d_five dpow d_five, 5, 0.5 $out "the square root of 5=" + d_five d_five = d_five - 1 / 2 d_num2 = 1 d_num1 = 1 d_count = 0 d_loop = 1 dwhi d_loop = 1 dinc d_count d_ratio = d_num2 / d_num1 s_any = d_count + ". " + d_num2 + " / " + d_num1 + " " + d_ratio $app s_any, " " + d_five $out s_any d_any = d_num1 + d_num2 d_num2 = d_num1 d_num1 = d_any 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_fibonacci subr sub_test_stod 'updated 2002/07/31 vari s_any, d_any, s_dot, d_dot vari s_input s_input = "1" $whi s_input <> "*" $inp s_input, "enter a string to test $tod" $tod d_dot, s_input $out "d_dot=" + d_dot $out "s_input=" + s_input endw ends sub_test_stod subr sub_doubling 'updated 2000/12/15 vari d_double, d_half, d_linecount, d_count vari d_loop, s_input d_loop = 1 d_double = 1 d_half = 0 d_count = 1 d_linecount = 0 dwhi d_loop = 1 d_double = d_double * 2 d_half = 1 / d_double + d_half $out d_count + " " + d_double + " " + d_half dinc d_linecount dift d_linecount > 9 d_linecount = 0 $inp s_input,"Pause, * to end" $ift s_input = "*": dinc d_loop endi dinc d_count endw ends sub_doubling subr sub_adding_rounding 'updated 2003/09/14 'add up floating point numbers and rounding vari d_any, s_any, d_dot, s_dot, s_out vari d_loop, d_count, d_totcount vari d_number, s_pick, d_pick, d_good vari d_total1, d_total2, d_total3 d_loop = 1 dwhi d_loop = 1 d_good = 1 d_number = 0 $inp s_any, "enter number to total up" $isd d_any, s_any dift d_any = 1 $tod d_number, s_any $trb s_any, s_any else dinc d_good dinc d_loop endi dift d_good = 1 d_totcount = 0 $inp s_any, "enter number of times to total" $isd d_any, s_any dift d_any = 1: $tod d_totcount, s_any endi dift d_good = 1 d_count = 0 d_total1 = 0 d_total2 = 0 d_total3 = 0 dwhi d_count < d_totcount d_total1 = d_total1 + d_number d_total2 = d_total2 + d_number d_total3 = d_total3 + d_number 'round d_total2 d_total2 = d_total2 * 100 drou d_total2, d_total2 d_total2 = d_total2 / 100 'truncate d_total3 d_total3 = d_total3 * 100 dtru d_total3, d_total3 d_total3 = d_total3 / 100 dinc d_count endw s_out = "adding " + d_number + " up " + d_totcount $app s_out, " times" $out s_out $out "rounding and truncating is to cents" $out "just adding the total is " + d_total1 $out " rounding the total is " + d_total2 $out " truncating the total is " + d_total3 $inp s_any, "return" endi endw ends sub_adding_rounding subr sub_tag_numbers 'updated 2006/05/24, 2005/09/05, 2005/04/18, 2001/03/05 'Tag numbers vari d_any, s_any, d_dot, s_dot vari d_total, d_count, d_date, s_date vari d_lines, s_number, s_out vari d_tofile, s_filename d_total = 1 $inp s_any, "How many?" $isd d_any, s_any dift d_any = 1: $tod d_total, s_any d_date = 60500 $inp s_any, "Enter begining date, ie. 060500" $isd d_any, s_any dift d_any = 1: $tod d_date, s_any d_tofile = 1 dift d_tofile = 1 $inp s_filename, "enter the name of the file" flen d_any, s_filename dift d_any >= 0 $inp s_any, "1 = purge existing file" $ift s_any = "1": fdel d_any, s_filename endi endi d_lines = 0 d_count = 1 dwhi d_count <= d_total d_any = d_date \ 2 dto$ s_dot, d_any, 0, 0 d_any = 1 dwhi d_any > 0 $lok d_any, s_dot, 1, "0" dift d_any > 0: $del s_dot, d_any, 1 endw $sor s_number, s_dot, 1 $tod d_any, s_number dto$ s_number, d_any, 8, 0 dto$ s_date, d_date, 0, 0 $len d_any, s_date dift d_any = 5: s_date = "0" + s_date $ins s_date, 5, "/" $ins s_date, 3, "/" dto$ s_dot, d_count, 4, 0 s_out = s_dot + ". " + s_date + s_number $out s_out fapp d_any, s_filename, s_out d_date = d_date + 100 d_any = d_date % 10000 \ 100 dift d_any > 31 d_date = d_date - 3100 + 10000 d_any = d_date \ 10000 dift d_any > 12 'subtract 120000 and add 1 d_date = d_date - 60000 - 60000 + 1 endi endi dinc d_count endw $inp s_any, "return" ends sub_tag_numbers subr sub_add_one 'updated 2000/12/15 'add one to a big number vari d_any, s_any, d_dot, s_dot vari d_number, s_number, d_delta, s_delta vari d_loop, d_good, d_count, d_old vari d_round, d_dinc, d_integerout d_good = 1 $inp s_number, "Enter the number" $isd d_any, s_number dift d_any <> 1: dinc d_good dift d_good = 1 $inp s_any, "1 = use dinc instead of +" d_dinc = 2 $ift s_any = "1": d_dinc = 1 $inp s_any, "1 = round to whole number after each add" d_round = 2 $ift s_any = "1": d_round = 1 $inp s_any, "1 = output as an integer" d_integerout = 2 $ift s_any = "1": d_integerout = 1 $tod d_number, s_number d_old = d_number $out "show the incremented number and the delta amount" d_delta = d_number - d_old ded$ s_number, d_number, 20, 20 ded$ s_delta, d_delta, 20, 20 $out "n=" + s_number + ", d=" + s_delta d_count = 0 d_loop = 1 dwhi d_loop = 1 dift d_dinc = 1 d_number = d_number + 1 else dinc d_number endi dift d_round = 1: d_number = d_number \ 1 d_delta = d_number - d_old dift d_integerout = 1 ded$ s_number, d_number, 0, 0 ded$ s_delta, d_delta, 0, 0 else ded$ s_number, d_number, 0, 20 ded$ s_delta, d_delta, 0, 20 endi $out "n=" + s_number + ", d=" + s_delta dinc d_count dift d_count > 5 d_count = 0 s_any = "more, * to end, round=" + d_round $app s_any, ", dinc=" + d_dinc $app s_any, ", as integer=" + d_integerout $inp s_any, s_any $ift s_any = "*": dinc d_loop endi endw endi ends sub_add_one subr sub_double_math 'updated 2005/04/18, 2000/12/15 'do math with doubles vari d_any, s_any, d_dot, s_dot, d_toe, d_pie vari d_num1, d_num2, s_operator, d_answer, d_loop, s_num1 vari s_asterisks, s_pick, d_pick, d_total, d_count $ch$ s_asterisks, "*", 76 $out "2 = double math" $out "3 = adding machine" $out "4 = test %" $out "5 = power or exponentiation" $inp s_pick, "choose a number" $isd d_any, s_pick d_pick = 0 dift d_any = 1: $tod d_pick, s_pick dift d_pick = 2 d_loop = 1 dwhi d_loop = 1 $inp s_num1, "enter the first number, * to end" $ift s_num1 = "*" dinc d_loop else $tod d_num1, s_num1 $out "The first number=" + d_num1 $out " " $inp s_num1, "enter the second number" $tod d_num2, s_num1 $out "The second number=" + d_num2 $out " " $inp s_operator, "enter the operator, +-*/" $ift s_operator = "+": d_answer = d_num1 + d_num2 $ift s_operator = "-": d_answer = d_num1 - d_num2 $ift s_operator = "*": d_answer = d_num1 * d_num2 $ift s_operator = "/": d_answer = d_num1 / d_num2 $out s_asterisks $out d_num1+" "+s_operator+" "+d_num2+" = "+d_answer $out s_asterisks $out " " endi endw endi dift d_pick = 3 d_count = 0 d_total = 0 d_loop = 1 dwhi d_loop = 1 ded$ s_num1, d_total, 0, 0 s_any = s_num1 + " = Total of " + d_count + " terms, " $app s_any, "enter a number to be added in" $inp s_num1, s_any $isd d_any, s_num1 dift d_any = 1 $tod d_any, s_num1 d_total = d_total + d_any dinc d_count else $out s_num1 + " is not numeric" $ift s_num1 = "*": dinc d_loop endi endw ded$ s_num1, d_total, 0, 0 $inp s_any, s_num1 + " = total of " + d_count + " terms" endi dift d_pick = 4 d_loop = 1 dwhi d_loop = 1 $inp s_any, "test mod, enter first number, * to end" $isd d_any, s_any dift d_any = 1 $tod d_num1, s_any d_any = d_num1 \ 1 $out d_num1 + " rounded by 0 is " + d_any d_any = d_num1 \ 1 $out d_num1 + " rounded by 2 is " + d_any d_any = d_num1 \ 1 $out d_num1 + " truncated by 0 is " + d_any d_any = d_num1 \ 1 $out d_num1 + " truncated by 2 is " + d_any $inp s_any, "test mod, enter second number, * to end" $isd d_any, s_any dift d_any = 1 $tod d_num2, s_any d_any = d_num2 \ 1 $out d_num2 + " rounded by 0 is " + d_any d_any = d_num1 \ 1 $out d_num1 + " rounded by 2 is " + d_any d_any = d_num2 \ 1 $out d_num2 + " truncated by 0 is " + d_any d_any = d_num1 % d_num2 $out d_num1 + " mod " + d_num2 + " = " + d_any else $out "bad number = " + s_any dinc d_loop endi else $out "bad number = " + s_any dinc d_loop endi endw endi dift d_pick = 5 d_loop = 1 dwhi d_loop = 1 $inp s_any, "enter first number to be exponentiated, * to end" $isd d_any, s_any dift d_any = 1 $tod d_num1, s_any $out "the first number is " + d_num1 $inp s_any, "enter the exponent, * to end" $isd d_any, s_any dift d_any = 1 $tod d_num2, s_any $out "the second number is " + d_num2 dpow d_any, d_num1, d_num2 s_any = d_num1 + " raised to " + d_num2 $app s_any, " is " + d_any $out s_any else $out "bad number = " + s_any dinc d_loop endi else $out "bad number = " + s_any dinc d_loop endi endw endi dift d_pick = 6 d_loop = 1 dwhi d_loop = 1 $out "enter a number, * to end" $out "2.8 is a good one to try" $inp s_any, "12345678901234567890" $isd d_any, s_any dift d_any = 1 $tod d_num1, s_any d_dot = 0 dwhi d_dot <= 15 d_any = d_num1 \ 1 s_any = d_num1 + " rounded to " + d_dot $app s_any, " decimals is " + d_any $out s_any dinc d_dot endw $inp s_any, "return to see \ 1" d_dot = 0 dwhi d_dot <= 15 d_any = d_num1 \ 1 s_any = d_num1 + " truncated to " + d_dot $app s_any, " decimals is " + d_any $out s_any dinc d_dot endw $inp s_any, "return to see dto$" d_dot = 0 dwhi d_dot <= 15 dto$ s_dot, d_num1, 20, d_dot $trb s_dot, s_dot s_any = d_num1 + " using dto$ with " + d_dot $app s_any, " decimals is " + s_dot $out s_any dinc d_dot endw else dinc d_loop endi endw endi ends sub_double_math subr sub_large_string 'updated 2000/12/15 vari s_any, d_any vari s_test,d_loop,d_long,s_take,d_time,s_date,d_sec1,d_sec2 s_test = "1234567890" d_loop = 1 dwhi d_loop = 1 dsec d_sec1 $app s_test, s_test dsec d_sec2 d_sec2 = d_sec2 - d_sec1 $out "Seconds to build=" + d_sec2 $len d_long, s_test $out "The length is=" + d_long $inp s_take, "Hit return to double the string, * to end" $ift s_take = "*": dinc d_loop endw $inp s_take, "enter Z to zero the string length" $ift s_take = "Z": s_test = sg_nothing ends sub_large_string subr sub_time_watch 'updated 2000/12/15 'watch time change vari d_any vari s_time, s_newtime, d_good, d_count s_time = "x" d_good = 1 dwhi d_good = 1 $dat s_newtime $ift s_newtime <> s_time dinc d_count s_time = s_newtime $out d_count + ". " + s_newtime endi endw ends sub_time_watch subr sub_lines_out 'updated 2000/12/15 'output lines 971/993 in the array to the screen vari d_index, s_line d_index = 993 dwhi d_index >= 971 ito$ s_line, d_index $out s_line ddec d_index endw ends sub_lines_out subr sub_sam_bass 'updated 2006/08/22, 2006/08/21, 2004/10/21 'sam_bass or not sam_bass vari d_any, s_any, d_dot, s_dot, s_out vari d_grab, s_file1, s_file2, d_yessambass vari d_char, s_char, d_shift, d_good, d_match vari d_byte, s_line, d_loop, d_long, d_filelen vari d_sambassnew, d_sambassold, d_sambasscount vari d_high, d_low, d_onemillion, d_big vari s_alpha, s_word, d_process, d_total, d_action d_process = 1 $tod d_big, "700000001" $inp s_any, "1 = test" $ift s_any = "*": dinc d_process $ift s_any = "1" $inp s_any, "enter sambass ie. 180,196,334 or 122,976,458" $ift s_any = "*": dinc d_process $tod d_sambassnew, s_any dpow d_onemillion, 10, 6 dpow d_low, 10, 10 d_total = 0 d_high = 0 d_match = 0 d_sambasscount = 0 d_sambassold = d_sambassnew d_loop = d_process dwhi d_loop = 1 d_action = 0 d_sambassnew = d_sambassnew * 3 + 35731 % d_big dinc d_sambasscount d_total = d_total + d_sambassnew dift d_sambassnew > d_high d_high = d_sambassnew d_action = 1 endi dift d_sambassnew < d_low d_low = d_sambassnew d_action = 1 endi 'tell every millionth d_any = d_sambasscount % d_onemillion dift d_any = 0: d_action = 1 'tell if match dift d_sambassnew = d_sambassold: d_action = 1 dift d_action = 1 ded$ s_out, d_sambasscount, 0, 0 ded$ s_any, d_sambassnew, 0, 0 $app s_out, ", now=" + s_any ded$ s_any, d_low, 0, 0 $app s_out, ", lo=" + s_any ded$ s_any, d_high, 0, 0 $app s_out, ", hi=" + s_any d_any = d_total / d_sambasscount ded$ s_any, d_any, 0, 0 $app s_out, ", ave=" + s_any $out s_out endi dift d_sambassnew = d_sambassold $inp s_any, "match" dinc d_loop dinc d_process endi endw endi dift d_process = 1 $inp s_file1, "Enter the name of the first file" $ift s_file1 = "*": dinc d_process endi dift d_process = 1 $inp s_file2, "Enter the name of the second file" $ift s_file2 = "*": dinc d_process endi dift d_process = 1 $inp s_word, "Enter a word, alphanumeric please" $ift s_word = "*": dinc d_process endi dift d_process = 1 d_yessambass = 2 $inp s_any, "1=to sam bass, 2=from sam_bass" $ift s_any = "*": dinc d_process $ift s_any = "1": d_yessambass = 1 endi 'numbers are 48/57 'letters are 65/90 'char are 33/126 'the space is 32 dift d_process = 1 $cup s_word, s_word $trb s_word, s_word $cut s_word, s_word, 1, 10 'validate $len d_long, s_word s_alpha = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" d_sambassnew = 0 d_dot = 1 dwhi d_dot <= d_long $cut s_char, s_word, d_dot, 1 $lok d_char, s_alpha, 1, s_char dift d_char > 0 d_sambassnew = d_sambassnew * 5 + d_char endi ded$ s_any, d_sambassnew, 0, 0 $out s_any dinc d_dot endw d_sambassnew = d_sambassnew % d_big d_sambassold = d_sambassnew d_sambasscount = 1 endi dift d_process = 1 ded$ s_any, d_sambassnew, 0, 0 $inp s_any, "d_sambassnew=" + s_any + ", * to end" $ift s_any = "*": dinc d_process endi dift d_process = 1 'validate the file names $cup s_file1, s_file1 $cup s_file2, s_file2 flen d_filelen, s_file1 dift d_filelen < 1 dinc d_process $out "the first file does not exist" endi endi dift d_process = 1 fdel d_any, s_file2 d_grab = 4000 d_byte = 1 endi d_loop = d_process dwhi d_loop = 1 $out d_byte frea s_line, s_file1, d_byte, d_grab $len d_long, s_line dift d_long > 0 d_dot = 1 dwhi d_dot <= d_long d_sambassnew = d_sambassnew * 3 + 17 % d_big dinc d_sambasscount dift d_sambassnew = d_sambassold ded$ s_any, d_sambasscount, 0, 0 ded$ s_dot, d_sambassnew, 0, 0 $out "count=" + s_any + ", sambass=" + s_dot endi $cut s_char, s_line, d_dot, 1 $chd d_char, s_char dift d_char >= 32 dift d_char <= 126 d_shift = d_sambassnew % 95 + 1 dift d_yessambass = 1 d_char = d_char + d_shift else d_char = d_char - d_shift endi dift d_char < 32: d_char = d_char + 95 dift d_char > 126: d_char = d_char - 95 'put back in dch$ s_char, d_char, 1 $rep s_line, d_dot, s_char endi endi dinc d_dot endw fwri d_any, s_file2, d_byte, s_line dbad d_any = 0 endi d_byte = d_byte + d_grab dift d_byte > d_filelen: dinc d_loop endw $inp s_any, "done" ends sub_sam_bass subr sub_hash 'updated 2005/02/08 vari d_any, s_any, d_dot, s_dot, s_out vari d_loop1, d_loop2, s_string, d_hash, d_value vari d_good, d_byte, s_byte, d_char, d_long vari d_big d_loop1 = 1 dwhi d_loop1 = 1 d_good = 1 $inp s_string, "enter string, * to end" $ift s_string = "*" dinc d_loop1 dinc d_good endi dift d_good = 1 d_hash = 0 $tup s_string, s_string $len d_long, s_string d_byte = 1 d_loop2 = 1 dwhi d_loop2 = 1 $cut s_byte, s_string, d_byte, 1 $chd d_char, s_byte '48 to 57 is 0 to 9 '65 to 90 is A to Z '95 is _ d_value = 0 dift d_char >= 48 dift d_char <= 95: d_value = d_char endi d_any = d_value * d_value * d_value d_hash = d_hash * 2 + d_any dpow d_big, 10, 9 dift d_hash > d_big: d_hash = d_hash % d_big ded$ s_any, d_hash, 0, 0 $out s_byte + " " + s_any dinc d_byte dift d_byte > d_long: dinc d_loop2 endw endi endw ends sub_hash subr sub_file_total_characters 'updated 2005/07/24 vari s_any, d_any, s_dot, d_dot vari s_filename, s_record, d_filebyte vari d_loop, d_good, d_long vari d_chartotal, d_count, d_lines $inp s_filename, "enter filename" d_filebyte = 1 d_lines = 0 d_chartotal = 0 d_count = 0 d_loop = 1 dwhi d_loop = 1 dinc d_lines d_any = d_lines % 100 dift d_any = 0: $sho "lines=" + d_lines d_good = 1 fsip s_record, s_filename, d_filebyte dift d_filebyte = 0 dinc d_loop dinc d_good endi dift d_good = 1 $trb s_record, s_record $len d_long, s_record d_dot = 1 dwhi d_dot <= d_long dinc d_count $cut s_dot, s_record, d_dot, 1 $chd d_any, s_dot dift d_any > 32 d_chartotal = d_chartotal + d_any endi dinc d_dot endw endi endw ded$ s_any, d_chartotal, 0, 0 $out "total characters=" + s_any ded$ s_any, d_count, 0, 0 $out "count=" + s_any ded$ s_any, d_lines, 0, 0 $out "lines=" + s_any $inp s_any, "done" ends sub_file_total_characters subr sub_prog_teapro_indent 'updated 2008/01/10 '2007/03/26, 2007/03/25, 2006/07/13, 2005/01/16, 2004/10/21 'indent a Teapro program vari d_any, s_any, d_dot, s_dot vari s_filename1, s_filename2, d_filebyte vari d_beg, d_end, s_command vari d_process, d_shift, d_output, d_show vari d_delta, d_spaces, s_spaces, d_inquote, s_quote vari s_line, d_good, d_loop, d_count vari d_record, s_record, d_byte, s_byte, d_long d_process = 1 dift d_process = 1 $inp s_filename1, "input filename" $ift s_filename1 = "*": dinc d_process endi dift d_process = 1 $inp s_filename2, "output filename" $ift s_filename2 = "*": dinc d_process endi dift d_process = 1 flen d_any, s_filename2 dift d_any >= 0 $inp s_any, "1=purge old file=" + s_filename2 $ift s_any = "*": dinc d_process $ift s_any = "1": fdel d_any, s_filename2 endi endi dift d_process = 1 d_shift = 4 $inp s_any, "enter shift amount, default=4" $ift s_any = "*": dinc d_process $isd d_any, s_any dift d_any = 1: $tod d_shift, s_any endi d_count = 0 d_spaces = 0 d_record = 0 d_loop = d_process dwhi d_loop = 1 d_delta = 0 d_good = 1 d_output = 1 d_show = 2 fsip s_record, s_filename1, d_filebyte dift d_filebyte = 0 dinc d_good dinc d_output dinc d_loop endi dift d_good = 1 dinc d_record d_any = d_record % 100 dift d_any = 0: $sho "record=" + d_record 'get the line $bes s_record, s_record $trb s_line, s_record 'do nothing to lines beginning with < $cut s_byte, s_line, 1, 1 $ift s_byte = "<": dinc d_good 'do nothing to blank lines $len d_any, s_line dift d_any = 0 s_line = " " dinc d_good endi endi dift d_good = 1 'count lines to shift dinc d_count $cut s_command, s_line, 1, 4 $cup s_command, s_command $ift s_command = "SUBR" d_spaces = 0 d_delta = d_shift d_show = 1 endi $lok d_dot, "DIFT.$IFT", 1, s_command dift d_dot > 0 $lok d_dot, s_line, 1, ":" dift d_dot = 0 d_delta = d_shift d_show = 1 else 'is the colon in quotes or not 'is there a colon not in quotes d_inquote = 2 s_quote = "#" d_delta = d_shift d_show = 1 $len d_long, s_line d_byte = 1 dwhi d_byte <= d_long 'do we have a quote $cut s_byte, s_line, d_byte, 1 d_dot = 2 $ift s_byte = #"#: d_dot = 1 $ift s_byte = "#": d_dot = 1 dift d_dot = 1 dift d_inquote = 1 $ift s_byte = s_quote dinc d_inquote endi else d_inquote = 1 s_quote = s_byte endi endi $ift s_byte = ":" dift d_inquote <> 1 d_delta = 0 dinc d_show endi endi dinc d_byte endw endi endi $ift s_command = "ELSE" d_spaces = d_spaces - d_shift d_delta = d_shift d_show = 1 endi $ift s_command = "DWHI" d_delta = d_shift d_show = 1 endi $ift s_command = "$WHI" d_delta = d_shift d_show = 1 endi s_dot = "ENDI.ENDW" $lok d_dot, s_dot, 1, s_command dift d_dot > 0 d_spaces = d_spaces - d_shift d_show = 1 endi $ift s_command = "ENDS" d_spaces = 0 d_show = 1 endi endi dift d_good = 1 'do the indentation spaces $ch$ s_spaces, " ", d_spaces s_line = s_spaces + s_line d_spaces = d_spaces + d_delta endi dift d_output = 1 'output the record fapp d_any, s_filename2, s_line dbad d_any = 0 endi dift d_show = 1 $out s_line endi endw $inp s_any, "done, count=" + d_count ends sub_prog_teapro_indent subr sub_menu_testing 'updated 2011/09/14 vari d_any, s_any, d_dot, s_dot, s_out, d_pick $out "1. sub_oldtoe_line_testing" $inp s_any, "choose a number" $isd d_any, s_any dift d_any = 1: $tod d_pick, s_any dift d_pick = 1: sub_oldtoe_line_testing ends sub_menu_testing subr sub_oldtoe_line_testing 'updated 2011/09/14 vari d_any, s_any, d_dot, s_dot, s_out vari d_loop, s_testline, s_lineinto, s_lineoutof, s_key s_testline = "3jE.!sL,%~8sWm]7}:$*'Lk?&J;" $out "default=" + s_testline $inp s_any, "enter test line to work on" $len d_any, s_any dift d_any > 0: s_testline = s_any d_loop = 1 dwhi d_loop = 1 $inp s_key, "enter key" $ift s_key = "*": dinc d_loop $out "test =" + s_testline $toe s_lineinto, s_testline, s_key, 1 $out "into =" + s_lineinto $toe s_lineoutof, s_testline, s_key, 2 $out "outof=" + s_lineoutof endw ends sub_oldtoe_line_testing subr sub_xyzmath 'updated 2005/08/07, 2005/04/18, 2004/01/04 'solve a multi number math expression in sg_pass1 'the format is: x=123*567+4.6 etc or y=123*567+4.6 'put answer in dg_xvalue, dg_yvalue, dg_zvalue vari d_any, s_any, d_dot, s_dot, s_out, s_lok vari d_good, d_long, d_loop, d_error, 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_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 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, 0 s_out = "x=" + s_any ded$ s_any, dg_yvalue, 0, 0 $app s_out, ", y=" + s_any ded$ s_any, dg_zvalue, 0, 0 $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_speed2 'updated 2005/09/05, 2003/01/29 'speed of computer vari d_any, s_any, d_dot, s_dot vari d_time1, d_time2, d_count, d_seconds, s_which, d_best vari d_millions, d_total, s_aster vari d_testcount1, d_testcount2 vari d_average1, d_average2, s_average $ch$ s_aster, "*", 76 $inp s_any, "1 = one million times, 2 = two million times etc." $isd d_any, s_any dift d_any <> 1: s_any = "1" $tod d_millions, s_any d_total = d_millions * 10000 * 100 $inp s_which, "1 = dinc loop, 2 = dinc loop repeat, 3 = dset" $out s_aster $out "We are looping " + d_millions + " millions of times" d_count = 0 $ift s_which = "1" 'dinc loop dsec d_time1 dwhi d_count < d_total dinc d_count endw dsec d_time2 $out s_aster d_seconds = d_time2 - d_time1 $out d_seconds + ", " + d_total endi $ift s_which = "2" 'repeat loop d_testcount2 number of times d_testcount2 = 99999 $inp s_any, "how many repeats?" $isd d_any, s_any dift d_any = 1: $tod d_testcount2, s_any d_testcount1 = 1 d_average1 = 0 d_average2 = 0 d_best = 99999 dwhi d_testcount1 <= d_testcount2 d_count = 0 dsec d_time1 dwhi d_count < d_total dinc d_count endw dsec d_time2 d_seconds = d_time2 - d_time1 d_average1 = d_average1 + d_seconds d_average2 = d_average1 / d_testcount1 dto$ s_average, d_average2, 5, 3 dift d_seconds < d_best: d_best = d_seconds ded$ s_any, d_total, 0, 0 dto$ s_dot, d_testcount1, 5, 0 s_any = s_dot + ". " + d_seconds + ", " + s_any + ", best=" $app s_any, d_best + ", ave=" + s_average $out s_any dinc d_testcount1 endw endi $ift s_which = "3" dsec d_time1 dwhi d_count < d_total d_count = d_count + 1 endw dsec d_time2 $out s_aster d_seconds = d_time2 - d_time1 $out d_seconds + ", " + d_total endi $ift s_which = "1" s_any = "dinc, seconds to loop " + d_millions $app s_any, " millions of times=" + d_seconds $out s_any endi $ift s_which = "3" s_any = "dset, seconds to loop " + d_millions $app s_any, " millions of times=" + d_seconds $out s_any endi $out s_aster $inp s_which, "return" ends sub_speed2 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_speedquick 'updated 2012/03/23, 2011/07/30, 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 dwhi d_any < d_total dinc d_any endw 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 dg_speedquick = d_lines / d_time / 1000 / 1000 ded$ s_any, dg_speedquick, 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_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_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/01/10, 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 vari d_time, d_max, d_count, s_dashes $sys s_any, 2 $out s_any $ch$ s_dashes, "-", 70 '50 million dinc loop d_max = 10000 * 5000 'dwhi loop $out s_dashes d_count = 0 dsec d_time dwhi d_count < d_max dinc d_count endw dsec d_any d_time = d_any - d_time ded$ s_any, d_count, 0, 0 $out "loops=" + s_any $out "dwhi dinc loop, seconds=" + d_time $out s_dashes sub_path_prog_memory $out s_dashes $inp s_any, "return" ends sub_speed_test