{
 }
unit teapro91; { Copyright (c) 1997-2007 by D La Pierre Ballard }
{ Teapro9 uses the OpenTea technology to be simple and solid. }
{ Teapro9 uses the teaquad technology to find larger prime numbers. }
{ In today's world, we need computer software that actually works. }
interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls,
    Forms, Dialogs, Menus, StdCtrls, Math;

type
    TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    btn_start: TButton;
    menu_help: TMenuItem;
    edit_input: TEdit;
    menu_file: TMenuItem;
    menu_view: TMenuItem;
    menu_About: TMenuItem;
    menu_Variables: TMenuItem;
    menu_ProgramCode: TMenuItem;
    menu_debug: TMenuItem;
    menu_open: TMenuItem;
    menu_exit: TMenuItem;
    label_show: TLabel;
    Pause1: TMenuItem;
    menu_generalhelp: TMenuItem;
    menu_help_commands: TMenuItem;
    menu_help_running: TMenuItem;

    { programmer functions }
    function fnd_modulus(
        const dp_number : double;
        const dp_divisor : double) : double;
    function fnb_comm_dift : boolean;
    function fnb_comm_sift : boolean;
    function fnb_more(const ps1 : string) : boolean;

    function fnd_decimal_eval(const pbyte_1 : byte) : double;
    function fni_decimal_eval(const pbyte_1 : byte) : integer;

    function fns_eliminate_blanks(const ps_rec : string) : string;
    function fns_from_double(
        const pd_num : double;
        const pbyte_commas : byte) : string;

    function fns_link_literal_numbers(const ps_rec : string) : string;
    function fns_link_literal_strings(const ps_rec : string) : string;

    function fni_link_last_endi(const pi_rec : integer) : integer;
    function fns_blank_escapes(const ps1 : string) : string;
    function fni_pattern(const pi_char : integer) : integer;

    function fns_string_eval(const pbyte_1 : byte) : string;
    function fns_string_parse(const ps1 : string) : string;
    function fns_subroutine(const pi_line : integer) : string;
    function fns_tpline_format(const ps1 : string) : string;
    function fns_tplines_to_show(const pi1, pi2 : integer) : string;
    function fni_yesnocancel(const ps1 : string) : integer;

    { programmer procedures }
    procedure sub_about;
    procedure sub_commands_to_int;
    procedure sub_debug;
    procedure sub_double_from_string(
        const ps1 : string;
        var pe2 : double;
        var pb3 : boolean);

    procedure sub_error_in_prog_line(const ps1 : string;
        const pi2 : integer);

    procedure sub_more_or_halt(const ps1 : string);
    procedure sub_get_program_name;
    procedure sub_help_commands;
    procedure sub_help_general;
    procedure sub_help_running;
    procedure sub_initialize;
    procedure sub_tpprog_build_array;
    procedure sub_tpline_perform_new;
    procedure sub_tpline_process;
    procedure sub_tpline_split(var s_rec1, s_rec2 : string);
    procedure sub_format_lines;
    procedure sub_link_first_parameter;
    procedure sub_link_dift_sift;
    procedure sub_link_variable_names;
    procedure sub_link_subroutines;
    procedure sub_memo_show(const ps1 : string; const pbyte_2 : byte);
    procedure sub_old_to_new;
    procedure sub_prog_process;
    procedure sub_program_error(const ps1 : string);
    procedure sub_store_decimal(const pbyte_1 : byte; const pd_1 : double);
    procedure sub_store_string(const pbyte_1 : byte; const ps_1 : string);
    procedure sub_terminate;
    procedure sub_view_code;
    procedure sub_validate_commands;
    procedure sub_validate_variables;
    procedure sub_validate_semicolon(const pbyte_1 : byte);
    procedure sub_validate_variable(
        const pi1 : integer;
        const ps2 : string);

    procedure sub_validate_append(const pi1 : integer);
    procedure sub_variables;
    procedure sub_variables_info;

    { command procedures below }
    procedure sub_comm_array(const pbyte_1 : byte);

    procedure sub_comm_dchs;
    procedure sub_comm_dfac;
    procedure sub_comm_dfak;
    procedure sub_comm_dpks;
    procedure sub_comm_dpow;
    procedure sub_comm_dset;
    procedure sub_comm_dsin(const pbyte_1 : byte);
    procedure sub_comm_dsys;
    procedure sub_comm_dtof;
    procedure sub_comm_dtos(const pbyte_1 : byte);
    procedure sub_comm_dtoi(const pbyte_1 : byte);

    procedure sub_comm_ends;
    procedure sub_comm_evar;

    procedure sub_comm_file(const pbyte_1 : byte);

    procedure sub_comm_finp;
    procedure sub_comm_fout;
    procedure sub_comm_frea;
    procedure sub_comm_fwri;
    procedure sub_comm_fsip;
    procedure sub_comm_fapp(const pbyte_1 : byte);

    procedure sub_comm_sapp;
    procedure sub_comm_sbak;
    procedure sub_comm_schd;
    procedure sub_comm_schs;
    procedure sub_comm_scnt;
    procedure sub_comm_scod;
    procedure sub_comm_sdat;
    procedure sub_comm_sdel;
    procedure sub_comm_sdot;
    procedure sub_comm_scut;
    procedure sub_comm_sfix(const pbyte_1 : byte);
    procedure sub_comm_sinp(const pbyte_1 : byte);
    procedure sub_comm_sins;
    procedure sub_comm_sisc;
    procedure sub_comm_sisd;
    procedure sub_comm_sist;
    procedure sub_comm_slen(const pbyte_1 : byte);
    procedure sub_comm_slok;
    procedure sub_comm_soff;
    procedure sub_comm_sout(const pbyte_1 : byte);
    procedure sub_comm_spar;
    procedure sub_comm_spkd;
    procedure sub_comm_sisp;
    procedure sub_comm_srep;
    procedure sub_comm_sset;
    procedure sub_comm_ssor;
    procedure sub_comm_ssys;
    procedure sub_comm_sswp;
    procedure sub_comm_stod;
    procedure sub_comm_stoe;
    procedure sub_comm_stoi(const pbyte_1 : byte);
    procedure sub_comm_itod;
    procedure sub_comm_itos;

    { end programmer functions and subroutines }

    procedure menu_exitClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure btn_startClick(Sender: TObject);
    procedure edit_inputKeyPress(Sender: TObject; var Key: Char);
    procedure About1Click(Sender: TObject);
    procedure menu_ProgramCodeClick(Sender: TObject);
    procedure menu_VariablesClick(Sender: TObject);
    procedure menu_debugClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure menu_openClick(Sender: TObject);
    procedure Pause1Click(Sender: TObject);
    procedure menu_generalhelpClick(Sender: TObject);
    procedure menu_help_commandsClick(Sender: TObject);
    procedure menu_help_runningClick(Sender: TObject);

private
    { Private declarations }
public
    { Public declarations }
end;

const
    { programmer defined constants }
    nl = Chr(10);

var
    Form1: TForm1;

    fs_tpprog_name : string;
    fi_tpline_last : integer;
    fd_total_lines : double;
    fs_subr_name : string;
    fi_max_length : integer;
    fi_comment_ct : integer;
    fi_subroutine_ct : integer;
    fi_line : integer;

    { for input from edit_input }
    fi_input : integer;
    fs_input : string;
    fb_string_input : boolean;

    fb_program_loop : boolean;
    fb_terminate : boolean;
    fb_error : boolean;

    { debug }
    fb_debug : boolean;
    fsa_debug : array[1..16] of string;

    { these hold the variables for tpprog }
    fea_var : array[1..2000] of double;
    fsa_var : array[1..4000] of string;
    fi_max_dvar : integer;
    fi_max_svar : integer;

    fea_array : array[1..8000] of double;
    fsa_array : array[1..2000] of string;
    fi_max_darray : integer;
    fi_max_sarray : integer;

    fi_dvar : integer;
    fi_svar : integer;
    fd_begin_time : double;

    { show on memo_show stack }
    fsa_show : array[1..35] of string;
    fi_show_lines : integer;
    fb_show : boolean;

    { these hold the program and the linking }
    fsa_tpline : array[1..15000] of string;
    fs_tpline : string;
    fi_tpline : integer;

    fbytea_command : array[0..15000] of byte;

    fia_link : array[1..15000] of integer;
    fi_link : integer;

    { subroutine stack }
    fia_sub : array[1..1000] of integer;
    fii_sub : integer;
    fi_max_sub : integer;
    fia_primes : array[1..1000] of integer;

    { string dynamic memory stack }
    fia_delta_s : array[1..1000] of integer;
    fii_delta_s : integer;
    fi_delta_s : integer;
    fi_max_delta_s : integer;

    { decimal dynamic memory stack }
    fia_delta_d : array[1..1000] of integer;
    fii_delta_d : integer;
    fi_delta_d : integer;
    fi_max_delta_d : integer;

    { these hold the program information }
    fi_prog_lines : integer;
    fi_global_strings : integer;
    fi_global_decimals : integer;
    fi_literal_strings : integer;
    fi_literal_decimals : integer;

    { untyped file processing }
    fs_filename_1 : string;
    fi_file_byte : integer;

implementation

{$R *.DFM}

procedure TForm1.sub_about;
{ updated 2007/01/20, 2007/01/19, 2006/08/24,
2005/09/07, 2005/04/29, 2005/03/29, 2005/03/22, 2004/04/17 }
var
    sz : string;
begin
    sz := '';
    sz := sz
        + 'This computer program is the Teapro9 interpreter, '
        + 'teapro9.exe, build 364, 2007/10/16. '
        + 'which interprets the Teapro programming language. '
        + 'The Teapro programming language, '
        + 'was invented on 14-DEC-1997 and utilizes the '
        + 'OpenTea Technology. '
        + 'The Teapro9 interpreter was begun on 14-DEC-1997.' + nl + nl

        + 'The Teapro9 interpreter was programmed in '
        + 'Delphi 2.01, Developer Edition, '
        + 'copyright (c) 1983-1996, Borland International, Inc.' + nl + nl

        + 'The Teapro9 interpreter, teapro9.exe, may be used for free '
        + 'by anyone, but there is no warranty of any kind whatsoever '
        + 'on teapro9.exe.' + nl + nl

        + 'The Teapro programming language may be used for free '
        + 'by anyone, but there is no warranty of any kind whatsoever '
        + 'on Teapro.' + nl + nl

        + 'The Teapro programming language, teapro9.exe, '
        + 'the OpenTea Technology, and the teaquad method '
        + 'are all copyright (c) 1997-2007 '
        + 'by D La Pierre Ballard.' + nl + nl

        + 'Per the OpenTea technology Teapro is simple and solid. ' + nl + nl
        + 'In today''s world, we need computer software that actually works.'
        + nl + nl

        + 'Please e-mail your comments to: dlb@teapro.com' + nl + nl
        + 'Time at start='
        + DateTimeToStr(fd_begin_time) + nl
        + 'Lines done='
        + FloatToStrF(fd_total_lines, ffNumber, 16, 0) + nl
        + Application.Exename;

    ShowMessage(sz);

end; { sub_about }


procedure TForm1.sub_tpline_process;
{ updated 2007/04/20, 2007/01/20, 2007/01/19 }
{ 2006/04/28, 2006/04/14, 2005/04/29, 2005/03/22, 2003/09/15 }
{ process the Teapro program }
var
    iz : integer;
begin
    { if in input mode process the input }
    if fb_string_input then sub_comm_sinp(5);

    { this is set to false when sub_terminate is called }
    iz := 0;
    fb_program_loop := true;

    while fb_program_loop do
    begin
        { inner loop }

        Inc(iz);
        if (iz > 1000) then
        begin
            Application.ProcessMessages;
            iz := 0;
        end;

        fd_total_lines := fd_total_lines + 1;

        if fb_debug then sub_debug;

        { perform the program line }
        sub_tpline_perform_new;

        { increment to the next fi_tpline }
        Inc(fi_tpline);
    end; { fb_program_loop }

    { clear the edit_input }
    edit_input.text := '';
end; { sub_tpline_process }


procedure TForm1.sub_tpline_perform_new;
{ updated 2007/04/15, 2007/04/14, 2007/01/19, 2006/06/02, 2006/05/12 }
{ 2006/04/29, 2006/04/14, 2005/06/20, 2005/03/22, 2004/10/19 }
{ perform the action, the new version }
var
    s_string : string;
    byte_command : byte;
begin
    { 12345678901234567890123 }
    { MOVE 12345n12345n12345n }
    fs_tpline := fsa_tpline[fi_tpline];
    byte_command := fbytea_command[fi_tpline];
    fi_link := fia_link[fi_tpline];
    { Showmessage(fs_tpline + ' ' + IntToStr(byte_command)); }

    {    s_commands := ''
        + 'DABS,DARC,DCH$,DDEC,DED$,DFAC,DIF1,'
        + 'DIFT,DINC,DLOG,DPK$,DPOW,DRAN,DROU,'
        + 'DSEC,DSET,DSIN,DTO$,DTOF,DTOI,DTRU,DWHI,'

        + 'ELSE,ENDI,ENDP,ENDS,ENDW,ESUB,XXXX,EVAR,'
        + 'ITO$,ITOD,'

        + '$APP,$BAK,$BES,$CH$,$CHD,$CLO,$CNT,$COD,$CUP,'
        + '$CUT,$DAT,$DEL,$DOT,$IF1,$IFT,$INP,$INS,$ISC,'
        + '$ISD,$ISP,$IST,$LEN,$LOK,$OFF,$OUT,$PAR,$PKD,'
        + '$REP,$SET,$SHO,$SOR,$SWP,$SYS,$TLO,$TOD,$TOI,'
        + '$TRB,$TRL,$TRR,$TUP,$WHI,'

        + 'FDAT,FDEL,FLEN,FREN,'
        + 'FINP,FOUT,'
        + 'FSIP,FAPP,FADD,'
        + 'FREA,FWRI,'

        + 'QAPP,QINP,QOUT,QSET,QTOI,'
        + 'XXXX,XXXX,XXXX,XXXX,XXXX,'
        + 'ARRZ,ARRB,ADDI,DSYS,DBAD,'
        + '$TOE,$HSH,DBUG,DFAK,GOTO,'
        + 'GTAG,SUBR,VARI';
    }
    Case byte_command of
        1 : sub_store_decimal(6, Abs(fnd_decimal_eval(13))); { DABS }
        2 : sub_comm_dsin(4); { DARC arc sine }
        3 : sub_comm_dchs;

        4 : { DDEC }
            begin
                if (fs_tpline[11] = 'D') then Inc(fi_link, fi_delta_d);
                fea_var[fi_link] := fea_var[fi_link] - 1;
            end;

        5 : sub_comm_dtos(1); { DED$ }
        6 : sub_comm_dfac;
        7 : { DIF1 }
           begin
                if not fnb_comm_dift then Inc(fi_tpline);
           end;

        8 : { DIFT }
            begin
                if not fnb_comm_dift then fi_tpline := fi_link;
            end;

        9 : { DINC }
            begin
                if (fs_tpline[11] = 'D') then Inc(fi_link, fi_delta_d);
                fea_var[fi_link] := fea_var[fi_link] + 1;
            end;

        10 : sub_comm_dsin(5); { log10 }
        11 : sub_comm_dpks;
        12 : sub_comm_dpow;
        13 : sub_store_decimal(6, Random); { DRAN }

        14 : sub_comm_dsin(1); { drou }
        15 : { DSEC }
            begin
                { 86400 = 60 * 60 * 24 and is the seconds / day }
                sub_store_decimal(6, Now * 86400);
            end;

        16 : sub_comm_dset;
        17 : sub_comm_dsin(3); { DSIN sine }
        18 : sub_comm_dtos(0); { DTO$ }
        19 : sub_comm_dtof; { DTOF }
        20 : sub_comm_dtoi(1); { DTOI }
        21 : sub_comm_dsin(2); { dtru }
        22 : { DWHI }
            begin
                if not fnb_comm_dift then fi_tpline := fi_link;
            end;

        23 : { ELSE }
            begin
                fi_tpline := fi_link;
            end;

        24 : { ENDI }
            begin
                fi_tpline := fi_link;
            end;
        25 : sub_terminate;
        26 : sub_comm_ends;
        27 : { ENDW }
            begin
                fi_tpline := fi_link;
            end;

        28 : { ESUB }
            begin
                { push into the sub stack where we have come from }
                Inc(fii_sub);
                if (fii_sub > fi_max_sub) then fi_max_sub := fii_sub;

                fia_sub[fii_sub] := fi_tpline;

                fi_tpline := fia_link[fi_tpline];
            end;

        30 : sub_comm_evar; { EVAR }

        31 : sub_comm_itos;
        32 : sub_comm_itod;

        33 : sub_comm_sapp;
        34 : sub_comm_sbak;
        35 : sub_comm_sfix(3); { $BES }
        36 : sub_comm_schs;
        37 : sub_comm_schd;
        38 : sub_comm_sfix(1); { $CLO }
        39 : sub_comm_scnt;
        40 : sub_comm_scod;
        41 : sub_comm_sfix(2); { $CUP }
        42 : sub_comm_scut;
        43 : sub_comm_sdat;
        44 : sub_comm_sdel;
        45 : sub_comm_sdot;
        46 : { $IF1 }
            begin
                if not fnb_comm_sift then Inc(fi_tpline);
            end;

        47 : { $IFT }
            begin
                if not fnb_comm_sift then fi_tpline := fi_link;
            end;

        48 : sub_comm_sinp(1); { $INP }
        49 : sub_comm_sins;
        50 : sub_comm_sisc;
        51 : sub_comm_sisd;
        52 : sub_comm_sisp;
        53 : sub_comm_sist;
        54 : sub_comm_slen(1); { $LEN }
        55 : sub_comm_slok;
        56 : sub_comm_soff;
        57 : sub_comm_sout(1); { $OUT }
        58 : sub_comm_spar;
        59 : sub_comm_spkd;
        60 : sub_comm_srep;
        61 : sub_comm_sset;
        62 : sub_comm_sout(2); { $SHO }
        63 : sub_comm_ssor; { $SOR }
        64 : sub_comm_sswp; { $SWP }
        65 : sub_comm_ssys;
        66 : sub_comm_sfix(7); { $TLO }
        67 : sub_comm_stod;
        68 : sub_comm_stoi(1); { $TOI }
        69 : sub_comm_sfix(4); { $TRB }
        70 : sub_comm_sfix(5); { $TRL }
        71 : sub_comm_sfix(6); { $TRR }
        72 : sub_comm_sfix(8); { $TUP }
        73 : { $WHI }
            begin
                if not fnb_comm_sift then fi_tpline := fi_link;
            end;

        74 : sub_comm_file(1); { FDAT }
        75 : sub_comm_file(2); { FDEL }
        76 : sub_comm_file(3); { FLEN }
        77 : sub_comm_file(4); { FREN }

        78 : sub_comm_finp;
        79 : sub_comm_fout;
        80 : sub_comm_fsip;
        81 : sub_comm_fapp(1); { FAPP }
        82 : sub_comm_fapp(2); { FADD }
        83 : sub_comm_frea;
        84 : sub_comm_fwri;

        95 : sub_comm_array(1); { ARRZ }
        96 : sub_comm_array(2); { ARRB }
        97 : sub_comm_dtoi(2); { ADDI }
        98 : sub_comm_dsys; { DSYS }
        99 : { DBAD }
            begin
                if fnb_comm_dift then
                    sub_program_error('bad data error');
            end;
        100: sub_comm_stoe; { $TOE }
        101: sub_comm_slen(2); { $HSH }
        102 : { DBUG }
            begin
                if fb_debug then fb_debug := false
                else fb_debug := true;
            end;
        103: sub_comm_dfak; { DFAK }
        104: fi_tpline := fi_link; { GOTO }
        105: ;{ GTAG }
        { SUBR,VARI should not occur }
    else
        sub_debug;
    end;
end; { sub_tpline_perform_new }


procedure TForm1.sub_debug;
{ updated 2003/12/15 }
var
    s_out : string;
    b_good : boolean;
    iz, iy, ix : integer;
    sz : string;
begin
    if (fi_tpline < 1) then fi_tpline := 1;

    { move lines performed up one twice }
    for iz := 1 to 15 do fsa_debug[iz] := fsa_debug[Succ(iz)];

    fsa_debug[15] := IntToStr(fi_tpline) + ': '
        + fsa_tpline[fi_tpline];

    { prep dialog box output }
    s_out := '';
    for iz := 1 to 16 do
    begin
        if (Length(fsa_debug[iz]) > 0) then
            s_out := s_out + fsa_debug[iz] + nl;
    end;

    { get variables in fsa_tpline }
    s_out := s_out + nl;
    fs_tpline := fsa_tpline[fi_tpline];

    for iz := 1 to Length(fs_tpline) do
    begin
        sz := Copy(fs_tpline, iz, 5);
        b_good := true;

        for iy := 1 to 5 do
        begin
            if (Pos(sz[iy], '0123456789') = 0) then b_good := false;
        end;

        if b_good then
        begin
            sz := fns_string_eval(iz);
            if (Length(sz) > 50) then sz := Copy(sz, 1, 50);
            s_out := s_out + Copy(fs_tpline, iz, 6)  + '=' + sz + nl;
        end;
    end;

    { add on other information }
    s_out := s_out
    + nl
    + fns_subroutine(fi_tpline)
    + ', fi_tpline=' + IntToStr(fi_tpline)
    + ', fi_link=' + IntToStr(fia_link[fi_tpline])
    + ', fi_delta_d=' + IntToStr(fi_delta_d)
    + ', fi_delta_s=' + IntToStr(fi_delta_s) + nl

    + 'global decimals='
    + IntToStr(fi_global_decimals + fi_literal_decimals)

    + ', global strings='
    + IntToStr(fi_global_strings + fi_literal_strings)

    + ', Lines done = '
    + FloatToStrF(fd_total_lines, ffNumber, 16, 0)
    + nl + nl

    + 'Yes=Continue, No=Variables, Ok=Code, Cancel=Debug off, '
    + 'Abort=End Program';

    iz := MessageDlg(s_out, mtCustom, [mbYes,mbNo,mbOk,mbCancel,mbAbort], 0);

    if (iz = mrNo) then sub_variables;
    if (iz = mrOk) then sub_view_code;
    if (iz = mrCancel) then fb_debug := false;
    if (iz = mrAbort) then sub_terminate;
end; { sub_debug }


procedure TForm1.sub_program_error(const ps1 : string);
{ updated 2004/05/17 }
var
    i_beg, i_end : integer;
    iz : integer;
    sz : string;
begin
    sz := 'program error: ' + ps1 + ' in following line.' + nl
    + IntToStr(fi_tpline) + ': '
    + fsa_tpline[fi_tpline] + nl;

    i_beg := fi_tpline - 8;
    i_end := fi_tpline + 8;

    sz := sz + nl + fns_tplines_to_show(i_beg, i_end);

    sz := sz
    + 'ok = skip this line,  '
    + 'yes = debug, '
    + 'abort = terminate the program.';

    iz := MessageDlg(sz, mtCustom, [mbOk,mbYes,mbAbort], 0);

    fb_error := true;
    if (iz = mrAbort) then sub_terminate;
    if (iz = mrYes) then sub_debug;
end; { sub_program_error }


procedure TForm1.sub_help_general;
{ updated 2006/06/11, 2006/06/09, 2004/04/24 }
var
    iz : integer;
    s_dashline : string;
    sz : string;
    b_more : boolean;
begin
    s_dashline := nl + StringOfChar('-', 20) + nl;

    b_more := true;
    sz := '';
    sz := sz
        + 'A Teapro program is a text file which has been '
        + 'created using any editor or word processor. '
        + 'The extension on the name of a Teapro program can be .tea '
        + 'or since it is a text file .txt will work too. '
        + 'The Teapro programming language is an extremely small '
        + 'and simple language which is '
        + 'interpreted rather than compiled. '
        + 'The Teapro9 interpreter, teapro9.exe, is small and uses '
        + 'few resources. '
        + 'However, complex programming can be done easily in '
        + 'Teapro since Teapro has very powerful '
        + 'string, number, file handling and control commands. '
        + 'A Teapro program may have as many as a total of '
        + '15000 lines of code. '
        + 'The Teapro language follows the OpenTea technology '
        + 'of simplicity, safety, and solidity.';

    if b_more then b_more := fnb_more(sz);

    sz := '';
    sz := sz
        + 'A Teapro program consists of lines each of which '
        + 'has a Teapro command which is usually '
        + 'followed by some comma separated parameters. '
        + 'The parameters are variables, constants and operators. '
        + 'Variables can either be global or local. '
        + 'A global variable '
        + 'can be seen by all of the subroutines in the Teapro '
        + 'program. '
        + 'Local variables can be seen only in the subroutine '
        + 'in which they are defined. '
        + 'Global variables are defined at the top of a Teapro '
        + 'program. '
        + 'Local variables are defined at the top of the '
        + 'subroutine in which they are used. '
        + 'In both cases the '
        + 'command used to create the variables is VARI. '

        + s_dashline

        + 'There are two types of variables: string and decimal. '
		+ 'Global string variables begin with "sg_" while global '
        + 'decimal variables begin with "dg_". '
        + 'Local string variables begin with "s_", '
        + 'and local decimal variables '
        + 'begin with "d_". '
		+ 'In each case, the rest of the variable name can be '
        + 'letters or numbers. '
        + 'A variable name must be from 5 to '
        + '64 long. '
        + 'Variable names which overlap within a subroutine '
        + 'are not allowed. For example: d_byte and d_bytes '
        + 'cannot both be used in the same subroutine. '

        + s_dashline

        + 'In Teapro programs '
        + 'commands and variables may be upper or lower case since '
        + 'case is not significant. '
        + 'In the examples which follow upper case is used for '
        + 'emphasis for Teapro commands but variables are in lower case. '
		+ 'Most Teapro programmers use all lower case. '
        + 'Spaces may be placed between the parameters to '
        + 'make the lines more readable. '
        + 'Indentation may be used for lines inside of control structures '
        + 'to make the appearance of the program better.';
    if b_more then b_more := fnb_more(sz);

    sz := '';
    sz := sz
        + 'Here is a small Teapro program that uses the global decimal '
        + 'variable dg_count to count the number of times that the '
        + 'local variable string s_line is shown on the screen. '
        + 'The variable s_line is set to the string "Hello there" '
        + 'and is shown three '
        + 'times each time the subroutine sub_show is called. '
        + 'In the subroutine sub_show the local '
        + 'decimal variable d_decimal '
        + 'is used to count the number of times the while loop loops. '
        + 'The string is shown a total of six times and then the '
        + 'count is shown also. ' + nl + nl

        + 'VARI dg_count' + nl

        + 'sub_main' + nl
        + 'ENDP' + nl

        + 'SUBR sub_main' + nl
        + '    VARI s_string' + nl
        + '    dg_count = 0' + nl
        + '    sub_show' + nl
        + '    sub_show' + nl
        + '    $INP s_string, "The count is=" + dg_count' + nl
        + 'ENDS sub_main' + nl

        + 'SUBR sub_show' + nl
        + '    VARI s_line, d_decimal' + nl

        + '    s_line = "Hello there"' + nl
        + '    d_decimal = 0' + nl
        + '    DWHI d_decimal < 3' + nl
        + '        $OUT s_line' + nl
        + '        DINC d_decimal' + nl
        + '        DINC dg_count' + nl
        + '    ENDW' + nl
        + 'ENDS sub_show';
    if b_more then b_more := fnb_more(sz);

    sz := '';
    sz := sz
        + 'In the examples and help showing the different '
        + 'commands in the Teapro programming language some rather general '
        + 'names are used for variables. '
        + 'Names like s_string, s_whole, s_part, s_new, and s_old '
        + 'are used for string variables. '
        + 'Names like d_decimal, d_long and d_byte '
        + 'are used for decimal variables. '
        + 'In some cases a variable used as a parameter in a Teapro '
        + 'command gives a value to be used when the command '
        + 'is performed, '
        + 'in some cases a variable recieves a value when '
        + 'the command is performed, and in '
        + 'some cases a variable both gives '
        + 'and recieves a value.'

        + s_dashline

        + 'String variables may be upto 60,000,000 bytes in length, '
        + 'if the memory of your computer will handle that. '
        + 'Trying to create a string longer than that will '
        + 'cause an error.'
        + s_dashline

        + 'Decimal numbers may be positive or negative with up to '
        + '15 digits and with the decimal point '
        + 'almost anywhere. '
        + 'Decimal literals ie. 123.45 or 5 or +1.5 or -12 etc. '
        + 'may be preceded by a plus + sign or a negative - sign. '
        + 'The + or - sign is considered to be part of the literal '
        + 'number. '
        + 'A numeric variable cannot be preceded by a + or - sign '
        + 'to change its sign.' + nl
        + 'proper is: d_any = d_any * d_dot * -1' + nl
        + 'improper is: d_any = d_any * - d_dot'
        + s_dashline

        + 'A literal value may be used for a parameter instead of a '
        + 'variable if that parameter '
        + 'gives a value to be used by the Teapro command rather '
        + 'than that that parameter receives a value.' + nl

        + 'String literals are enclosed in either double quotes '
        + 'ie. "string" or number signs ie. #string#.';
    if b_more then b_more := fnb_more(sz);

    sz := '';
    sz := sz
        + 'Notice in the Teapro commands that in the command '
        + 'name movement is usually left to right. '
        + 'However, in the parameters of the '
        + 'command, movement is usually right to left. '
        + 'For example, consider the command $TOD.'
        + 'In the command name, it is string to decimal, left to right. '
        + 'In the parameters, $TOD d_decimal, s_string, '
        + 'the movement is from s_string to d_decimal '
        + 'or from right to left. '
        + 'This rule will help you '
        + 'to understand many of the Teapro commands.'

        + s_dashline

        + 'If the command is $APP,$OUT,$SHO, or $INP then the right '
        + 'most parameter may be a string append expression. '
        + 'A string assignment command is the same. '
        + 'A string append expression example is to use "c" + "at" '
        + 'instead of "cat". The terms in a string append expression '
        + 'may be string literals, string variables, decimal literals, '
        + 'or decimal variables.';
    if b_more then b_more := fnb_more(sz);

    sz := '';
    sz := sz
        + 'One thing is very different in Teapro than in other '
        + 'languages: numerical assignment commands are evaluated '
        + 'strictly left to right in Teapro whereas in other languages '
        + 'the are evaluated as though they were algebraic expressions. '
        + 'In a decimal assigment line the terms on the right side of '
        + 'the equal sign may be literal decimals or variable decimals. '
        + 'A literal decimal number may have a plus sign '
        + 'or a minus sign '
        + 'in front to denote its sign.'
        + s_dashline

        + 'Comment lines can be added to a Teapro program by beginning '
        + 'them with a apostrophe, ie. ''. '
        + 'Blank lines can be used '
        + 'to make the Teapro program more readable. '
        + 'Comment lines and blank lines '
        + 'are completely ignored by the Teapro interpreter. '

        + s_dashline

        + 'In Teapro a serious program error such as a zero '
        + 'divide will bring up a dialog box to inform the '
        + 'user and to give the user the choice of trying to '
        + 'continue or aborting.';
    if b_more then b_more := fnb_more(sz);
end; { sub_help_general }


procedure TForm1.sub_help_commands;
{ updated 2007/06/16, 2007/05/06 }
{ 2007/04/28, 2007/04/16, 2007/04/14, 2007/03/04, 2007/01/19 }
{ 2006/06/11, 2006/06/09, 2006/06/02, 2006/05/23, 2006/05/14 }
{ 2006/05/12, 2006/04/30, 2006/04/29, 2006/04/28, 2006/04/14 }
{ 2005/06/20, 2005/04/18, 2005/04/16, 2005/03/23, 2004/10/20 }
var
    s_heading : string;
    s_dashline : string;
    sz : string;
    b_more : boolean;
begin
    s_dashline := nl + StringOfChar('-', 20) + nl;

    s_heading := 'Teapro string commands';
    b_more := true;

    sz := s_heading;
    sz := sz
        + s_dashline
        + 's_str1 = s_str2 + "string" + d_dec1 + -3' + nl
        + 'String assignment command. Append s_str2 and "string" '
        + 'and d_dec1 and -3 and put into s_str1. In the string '
        + 'assignment command the part to the right of the equal '
        + 'sign is a string append expression. '
        + 'Strings may be 60,000,000 bytes long.'

        + s_dashline
        + '$APP s_string1, s_string2 + s_string3' + nl
        + 'String append. In the string append command, the part '
        + 'to the right of the comma is a string append expression. '
        + 'Evaluate it and append it to the right side of s_string1.'

        + s_dashline
        + '$BAK d_byte, s_whole, d_start, s_part' + nl
        + 'Lookup string s_part in string s_whole starting at byte '
        + 'd_start looking backwardly and put the result in d_byte. '
        + 'If not found put zero in d_byte.'

        + s_dashline
        + '$BES s_new, s_old' + nl
        + 'Blank escape characters in s_old '
        + 'and store in s_new. '
        + 'Escape characters are < 32.'

        + s_dashline
        + '$CH$ s_new, s_char, d_long' + nl
        + 'Make string s_new from d_long of the first character '
        + 'of string s_char.'

        + s_dashline
        + '$CHD d_char, s_char' + nl
        + 'Put char number of first character of s_char into d_char.';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz

        + s_dashline
        + '$CLO s_new, s_old' + nl
        + 'Make s_old lower case and store in s_new.'

        + s_dashline
        + '$CNT d_count, s_string, s_find' + nl
        + 'Put count of occurrences of s_find in s_string into '
        + 'd_count. Occurrences cannot overlap.'

        + s_dashline
        + '$COD s_new, s_old' + nl
        + 'Code s_old to s_new. Code and decode are the same.'

        + s_dashline
        + '$CUP s_new, s_old' + nl
        + 'Make s_old upper case and store in s_new.'

        + s_dashline
        + '$CUT s_part, s_whole, d_start, d_long' + nl
        + 'Cut from s_whole at d_start for length d_long and '
        + 'put in s_part.'

        + s_dashline
        + '$DAT s_date' + nl
        + 'Put date and time string into s_date in format:' + nl
        + '25-SEP-1998 20:20:36 19980925202036';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz

        + s_dashline
        + '$DEL s_whole, d_start, d_long' + nl
        + 'Delete d_long bytes from s_whole at d_start'

        + s_dashline
        + '$DOT d_dot, s_string1, s_string2, d_count' + nl
        + 'Find dot = byte of occurrence d_count of s_string2 '
        + 'in s_string1. Occurrences cannot overlap. If not found '
        + 'put zero into d_dot.'

        + s_dashline
        + '$HSH d_hash, s_string' + nl
        + 'Find hash number d_hash for string s_string.'

        + s_dashline
        + '$IFT s_str1 > s_str2' + nl
        + '$IFT s_str1 > s_str2: d_dec1 = 3' + nl
        + 'If s_str1 is greater than s_str2 then perform the '
        + 'lines of the program until the matching ELSE or ENDi is found. '
        + 'Or, in the second case if the condition is true '
        + 'perform the non-control command beyond the colon.'

        + s_dashline
        + '$INP s_input, s_output' + nl
        + 'Output s_output and then input line from user into s_input. '
        + 'For security the maximum length of s_input is 100 bytes.'

        + s_dashline
        + '$INS s_whole, d_byte, s_part' + nl
        + 'Insert s_part into s_whole starting at d_byte. If d_byte '
        + '< 1 or d_byte > 1 plus length of s_whole then error.'

        + s_dashline
        + '$ISC d_yesno, s_string, s_char' + nl
        + 'String is made up of certain char. If s_string is made up of '
        + 'the first char of s_char then put 1 in d_yesno else 2.';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz

        + s_dashline
        + '$ISD d_yesno, s_number' + nl
        + 'If s_number can be converted to a decimal value put 1 '
        + 'in d_yesno. Otherwise put 2 in d_yesno.'

        + s_dashline
        + '$ISP d_yesno, s_string, s_pattern' + nl
        + 'String pattern char type compare of s_string and s_pattern. '
        + 'Char types: escapes, blank, punctuation, numbers, uppers, '
        + 'lowers, char > 126. If match put 1 in d_yesno else 2. '
        + '"123x?" matches "999z.". Lengths of the two must match too.'

        + s_dashline
        + '$IST d_yesno, s_string, s_type' + nl
        + 'String is made up of char type of first character of s_type. '
        + 'Char types: escapes, blank, punctuation, numbers, uppers, '
        + 'lowers, char > 126. If match put 1 in d_yesno else 2. '
        + '"12345" matches "9" and ",./[}" matches "*".'

        + s_dashline
        + '$LEN d_long, s_string' + nl
        + 'Put length of s_string into d_long.'

        + s_dashline
        + '$LOK d_byte, s_whole, d_start, s_part' + nl
        + 'Lookup string s_part in s_whole starting at byte '
        + 'd_start looking forward. If found put which byte in d_byte. '
        + 'If not found put zero in d_byte.'

        + s_dashline
        + '$OFF s_result, s_string, d_long' + nl
        + 'Cut off string end, put string of length d_long '
        + 'from end of s_string into s_result.';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz

        + s_dashline
        + '$OUT s_output' + nl
        + 'Output s_output which may be an append string. '
        + '$OUT drops to the next line before outputting. '
        + 'Characters < 32 are replaced with blanks.'

        + s_dashline
        + '$PAR s_toextract, s_csv, s_char, d_which' + nl
        + 'String parse. '
		+ 'Extract string s_toextract from the character separated value '
        + 'string s_csv as indicated by number d_which. '
		+ 'Strings in s_csv are separated by occurrences of s_char. '
        + 'The length of s_char must be 1. '
        + 'If d_which=1 return the string ending with the first '
        + 'occurrence of s_char in s_csv. '
        + 'if d_which=6 return the string ending with the sixth s_char.'

        + s_dashline
        + '$PKD d_yesno, d_number, s_packed' + nl
        + 'String packed to decimal. Change s_packed in '
        + 'packed decimal format to d_number. Decimal '
        + 'd_number will be a whole number. '
        + 'A packed number is also called BCD or binary coded decimal. '
        + 'If s_packed is valid put 1 in d_yesno else 2.'

        + s_dashline
        + '$REP s_whole, d_byte, s_part' + nl
        + 'Replace part of s_whole starting at d_byte with s_part. '
        + 'If d_byte < 1 '
        + 'or d_byte > 1 plus length of s_whole or s_part will not fit '
        + 'in s_whole then error.'

        + s_dashline
        + '$SHO s_output' + nl
        + 'Output s_output which may be a string append expression. '
        + '$SHO does not drop to the next line before outputting. '
        + 'Characters < 32 are replaced with blanks.';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz

        + s_dashline
        + '$SOR s_new, s_old, d_long' + nl
        + 'Sort lengths of d_long in s_old and put into s_new.'

        + s_dashline
        + '$SWP s_string, s_old, s_new' + nl
        + 'String swap. In s_string replace each occurrence of s_old with '
        + 's_new.'

        + s_dashline
        + '$SYS s_info, d_which' + nl
        + 'System or program information into s_info depending on d_which.'
        + nl
        + '1 = path and filename of this running Teapro9 interpreter' + nl
        + '2 = current subroutine'

        + s_dashline
        + '$TLO s_new, s_old' + nl
        + 'Trim low. Trim s_old and make lower case. Put into s_new.'

        + s_dashline
        + '$TOD d_number, s_number' + nl
        + 'String to decimal number. '
        + 'If string s_number can be converted to a valid decimal '
        + 'number put that number in d_number. If not give an error.'

        + s_dashline
        + '$TOE s_new, s_old, s_key, d_which' + nl
        + 'String to encoded. '
        + 'Encode s_old to s_new using keyword s_key. If d_which=1 '
        + 'encode, else decode.'

        + s_dashline
        + '$TOI d_index, s_string' + nl
        + 'String to index. Store the string s_string in the '
        + 'string array at index d_index. The string array has '
        + '2000 elements ranging from index 1 to index 2000.';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz

        + s_dashline
        + '$TRB s_new, s_old' + nl
        + 'Trim blanks and escape characters from both sides '
        + 'of s_old and store in s_new.'

        + s_dashline
        + '$TRL s_new, s_old' + nl
        + 'Trim blanks and escape characters from left side '
        + 'of s_old and store in s_new.'

        + s_dashline
        + '$TRR s_new, s_old' + nl
        + 'Trim blanks and escape characters from right side '
        + 'of s_old and store in s_new.'

        + s_dashline
        + '$TUP s_new, s_old' + nl
        + 'Trim upper case. Trim and make upper case s_old '
        + 'and store in s_new.'

        + s_dashline
        + '$WHI s_string1 > s_string2' + nl
        + 'String while. The while loop ends with ENDW. '
        + 'It continues looping while the comparison is true.'

        + s_dashline
        + 'ITO$ s_string, d_index' + nl
        + 'Index to string. Get the string at the index d_index '
        + 'from the string array and store it in s_string. '
        + 'The string array has 2000 elements ranging from index '
        + '1 to index 2000.'

        + s_dashline
        + 'ARRB' + nl
        + 'Blank string array of 2000 indexed strings. '
        + 'Use command ARRZ to zero the decimal array.';

    if b_more then b_more := fnb_more(sz);

    s_heading := 'Teapro decimal commands';
    sz := s_heading;
    sz := sz

        + s_dashline
        + 'd_dec1 = + d_dec2 - d_dec3 ? 3 * d_dec4 / d_dec5 % d_dec6 * -1 '
        + '@ 2'
        + nl + nl
        + 'Start with d_dec2, subtract d_dec3, truncate to 3 decimals, '
        + 'multiply by d_dec4, '
        + 'divide by d_dec5, do mod d_dec6, multiply by -1, '
        + 'round to 2 decimals '
        + 'and put the result in d_dec1.' + nl

        + 'Assignment arithmetic is evaluated left to right. '
        + 'Decimal variables or numeric literals are used. '
        + 'Decimal number literals may have a + or - sign. '
        + 'A data error brings up the Data Error dialog box.'

        + s_dashline
        + 'DABS d_result, d_number' + nl
        + 'Absolute value. Put absolute value of d_number '
        + 'into d_result.'

        + s_dashline
        + 'DARC d_radians, d_sine' + nl
        + 'Sine to radians. An sine of an angle is in '
        + 'd_sine. Put the angle in radians in d_radians.';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz

        + s_dashline
        + 'DBAD d_num1 > d_num2' + nl
        + 'Bad decimal variable value test. '
        + 'If the condition is true then bad. '
        + 'If bad then show the data error dialog box.'

        + s_dashline
        + 'DBUG' + nl
        + 'Toggles DEBUG on and off.'

        + s_dashline
        + 'DCH$ s_string, d_char, d_long' + nl
        + 'Make s_string from character d_char of length d_long.'

        + s_dashline
        + 'DDEC d_decimal' + nl
        + 'Decrement d_decimal by 1.';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz

        + s_dashline
        + 'DED$ s_number, d_number, d_long, d_places' + nl
        + 'Edit decimal number d_number into string of at least '
        + 'length d_long. The number of decimal places is d_places. '
        + 'The number is right justified in the string. '
        + 'Commas are inserted.'

        + s_dashline
        + 'DFAC d_factor, d_number' + nl
        + 'Factor or test for prime. '
        + 'Round d_number to an integer. '
        + 'Test d_number for its lowest integer factor. '
        + 'Put the lowest factor in d_factor. '
        + 'If d_factor is 1 then d_number is prime.'

        + s_dashline
        + 'DFAK d_factor, d_1quadpart, d_1quadmult' + nl
        + 'Factor or test for prime. '
        + 'Test d_number = d_1quadpart + d_1quadmult * d_1quadnum '
        + 'where d_1quadnum is 1 quadrillion or 1E15. '
        + 'Put the lowest factor in d_factor. '
        + 'If d_factor is 1 then d_number is prime. '
        + 'The teaquad method is used here.'

        + s_dashline
        + 'DIFT d_dec1 < d_dec2' + nl
        + 'DIFT d_dec1 < d_dec2: d_dec3 = 4' + nl
        + 'Begin an if block of lines which will end with endi. '
        + 'Or, put a colon and one non-control command to do if '
        + 'the if is true.'

        + s_dashline
        + 'DINC d_decimal' + nl
        + 'Increment d_decimal by 1.'

        + s_dashline
        + 'DLOG d_log, d_decimal' + nl
        + 'Find common logarithm base=10 of '
        + 'd_decimal and put into d_log.'

        + s_dashline
        + 'DPK$ s_packed, d_decimal, d_long' + nl
        + 'Decimal to packed format in string. Change d_decimal to '
        + 'a zero filled packed decimal string s_packed '
        + 'of length d_long. Decimal d_decimal is rounded to '
        + 'a whole number first. '
        + 'A packed number is also called BCD or binary coded decimal.';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz
        + s_dashline
        + 'DPOW d_result, d_number, d_power' + nl
        + 'Raise d_number to power d_power and put in d_result. '
        + 'd_number must be greater than zero.'

        + s_dashline
        + 'DRAN d_decimal' + nl
        + 'Put random decimal number between 0 and 1 in d_decimal.'

        + s_dashline
        + 'DROU d_dec1, d_dec2' + nl
        + 'Round d_dec2 and put into d_dec1. Round a decimal '
        + 'value of .5 away from zero.'

        + s_dashline
        + 'DSEC d_sec' + nl
        + 'Seconds since midnight of 30-DEC-1899 go into d_sec.'

        + s_dashline
        + 'DSIN d_sine, d_radians' + nl
        + 'Radians to the sine. An angle in radians is in '
        + 'd_radians. Put sine of that angle in d_sine.'

        + s_dashline
        + 'DSYS d_info, d_which' + nl
        + 'Decimal system info to d_info depending on d_which. '
        + 'If d_which=1 put total of string lengths in d_info. '
        + 'If d_which=2 put total lines run into d_info.'

        + s_dashline
        + 'DTO$ s_number, d_decimal, d_long, d_places' + nl
        + 'Make decimal d_decimal into a string of at least length '
        + 'd_long with the number of decimal places as d_places. '
        + 'The number is right justified in the string. '
        + 'No commas are inserted.';

    if b_more then b_more := fnb_more(sz);

    sz := s_heading;
    sz := sz

        + s_dashline
        + 'DTOF s_field, d_decimal, d_long' + nl
        + 'Decimal to field. Convert decimal d_decimal to a string '
        + 'of length d_long beginning with + or -, right justified '
        + 'and zero filled.'

        + s_dashline
        + 'DTOI d_index, d_dec2' + nl
        + 'Decimal to index. Store the decimal d_dec2 in the '
        + 'decimal array at index d_index. The decimal array has '
        + '8000 elements ranging from index 1 to index 8000.'

        + s_dashline
        + 'DTRU d_dec1, d_dec2' + nl
        + 'Truncate d_dec2 and put in d_dec1. Variable d_dec1 '
        + 'will be an integer closer to zero than d_dec1.'

        + s_dashline
        + 'DWHI d_dec1 < d_dec2' + nl
        + 'Begin a while loop which will end with endw.'

        + s_dashline
        + 'ITOD d_dec1, d_index' + nl
        + 'Index to decimal. Get the decimal at the index '
        + 'd_index from the decimal array and store it in '
        + 'd_dec1. The decimal array has 8000 elements ranging '
        + 'from index 1 to index 8000.'

        + s_dashline
        + 'ADDI d_index, d_decimal' + nl
        + 'Decimal add to decimal array at index. '
        + 'Add the decimal d_decimal to the '
        + 'decimal array at index d_index. The decimal array has '
        + '8000 elements ranging from index 1 to index 8000.'

        + s_dashline
        + 'ARRZ' + nl
        + 'Zero the decimal array of 8000 indexed decimals. '
        + 'Use command ARRB to blank the string array.';

    if b_more then b_more := fnb_more(sz);

    sz := 'Teapro control commands';
    sz := sz

        + s_dashline
        + 'DIFT, DWHI, $IFT, and $WHI' + nl
        + 'See these decimal and string commands.' + nl
        + 'ELSE : else is used in DIFT or $IFT blocks.' + nl
        + 'ENDI : ends an DIFT or a $IFT block.' + nl
        + 'ENDP : end of the program.' + nl
        + 'ENDS : end of the subroutine.' + nl
        + 'ENDW : end of a DWHI or $WHI block.' + nl
        + 'GOTO tag_loop : goto where GTAG tag_loop is.' + nl
        + 'GTAG tag_loop : line where GOTO tag_loop goes.' + nl
        + 'sub_main : exit to subroutine sub_main.' + nl
        + 'SUBR sub_main : beginning line of sub_main.';
    if b_more then b_more := fnb_more(sz);


    sz := 'Teapro file commands';
    sz := sz

        + s_dashline
        + 'FDAT d_date, s_date, s_filename' + nl
        + 'Put the decimal file date in d_date. '
        + 'Put the string file date in s_date. '
        + 'If the file does not exist put in a 0 '
        + 'and a nothing.'

        + s_dashline
        + 'FDEL d_yes, s_filename' + nl
        + 'Delete the file named in s_filename. If deleted put '
        + '1 in d_yes else put 2 in d_yes.'

        + s_dashline
        + 'FLEN d_long, s_filename' + nl
        + 'Put the length of file s_filename into d_long. '
        + 'If the file cannot be accessed in -1.'

        + s_dashline
        + 'FREN d_yes, s_newname, s_oldname' + nl
        + 'Rename file s_oldname to s_newname. If renamed put'
        + '1 in d_yes else put 2 in d_yes.';

    if b_more then b_more := fnb_more(sz);

    sz := 'Teapro file processing commands';
    sz := sz

        + s_dashline
        + 'FINP s_string, s_filename' + nl
        + 'File input, read the whole file s_filename '
        + 'into the string s_string.'

        + s_dashline
        + 'FOUT d_bytes, s_filename, s_string' + nl
        + 'File output, write the string s_string '
        + 'to make the whole file s_filename. The number of '
        + 'bytes written is put in d_bytes.'

        + s_dashline
        + 'FREA s_record, s_filename, d_byte, d_long' + nl
        + 'File get record, read s_filename at d_byte for '
        + 'length d_long and put in string s_record. '
        + 'Files begin at byte 1. d_long cannot be over 4096. '
        + 'String s_record may be shorter than d_long. '
        + 'Determine the success of FREA by the length of s_record. '
        + 'FREA and FWRI work well on any type of file.'

        + s_dashline
        + 'FWRI d_length, s_filename, d_byte, s_record' + nl
        + 'File put record, write s_record to file s_filename '
        + 'at d_byte and put the '
        + 'length written into d_length. Files begin '
        + 'at byte 1. s_record cannot be longer than 4096.';

    if b_more then b_more := fnb_more(sz);

    sz := 'Teapro file processing commands';
    sz := sz

        + s_dashline
        + 'FSIP s_record, s_filename, d_byte' + nl
        + 'File sip, read variable length record s_record '
        + 'from file s_filename beginning at byte d_byte, '
        + 'remove LF or CRLF at end and put beginning of '
        + 'next record in d_byte. Length of record cannot '
        + 'be over 4096. If no record read put 0 in d_byte, '
        + 'but records can be zero length. '
        + 'You should put 1 in d_byte for first read. '
        + 'FSIP works only with files that have a '
        + 'LF or CRLF at the end of each record. '
        + 'LR means a line feed or char 10. '
        + 'CRLF means a char 13 and a char 10.'

        + s_dashline
        + 'FADD d_length, s_filename, s_line' + nl
        + 'Append line to file, write line s_line to end of file '
        + 's_filename putting on a LF. Total length written '
        + 'goes into d_length and cannot be over 4096.'

        + s_dashline
        + 'FAPP d_length, s_filename, s_line' + nl
        + 'Append line to file, write line s_line to end of file '
        + 's_filename putting on a CRLF. Total length written '
        + 'goes into d_length and cannot be over 4096.';
    if b_more then b_more := fnb_more(sz);

    sz := '';
    sz := sz
        + 'the Teapro decimal assignment command and operators'

        + s_dashline
        + 'd_dec1 = 5 + d_dec2 / -3.14 - d_dec3 * 15.2' + nl
        + 'First, remember that the decimal assignment command '
        + 'evaluates the expression to the right of the equal sign '
        + 'strictly in left to right order and not as an algebraic '
        + 'expression as in other languages. '
        + 'Literal numbers may be preceded by a + or - sign. '
        + 'The following operators tell what to do with '
        + 'the term to the right '
        + 'of the operator with respect to the answer '
        + 'being calculated.'

        + s_dashline
        + '+ means to add the right term to the answer.' + nl
        + '- means to subtract the right term from the answer.' + nl
        + '* means to multiply the right term times the answer.' + nl
        + '/ means to divide the answer by the right term.' + nl
        + '% means to round the answer and the right term '
        + 'and find the mod which has the sign of the answer.' + nl
        + '\ means to round the answer and the right term '
        + 'and do an integer divide.' + nl
        + '@ means to round term1 to number of places in term2.' + nl
        + '? means to truncate term1 to number of places in term2.' + nl
        + 'A data error brings up the Data Error dialog box.';

    if b_more then b_more := fnb_more(sz);

end; { sub_help_commands }


procedure TForm1.sub_help_running;
{ updated 2000/01/01 }
var
    sz : string;
    b_more : boolean;
begin
    b_more := true;
    sz := '';
    sz := sz
    + 'This program is teapro9.exe. '
    + 'It is the Teapro9 interpreter Program that you must use to run '
    + 'a program written in the Teapro programming language. '
    + 'Both the Teapro9 interpreter program and the Teapro program should '
    + 'be in the same directory. '
    + 'Use any word processor to write your Teapro program. '
    + 'Save the program as a text file with the extension .tea. '
    + 'There are two ways to get this interpreter program to run '
    + 'that Teapro program. ' + nl + nl
    + '1. Run this Teapro9 interpreter Program '
    + 'and click File on the menu bar. '
    + 'Then choose: Open a Teapro Program. '
    + 'Then type in the name of the Teapro program and click Ok. '
    + 'Then click the Start Program button '
    + 'and this interpreter program '
    + 'will run that Teapro program. ' + nl + nl
    + '2. Setup this Teapro9 interpreter Program, teapro9.exe, on your '
    + 'Start Menu or as a Short Cut '
    + 'with the name of the Teapro program you wish to run as a '
    + 'parameter. '
    + 'For example, use for your command line the following: ' + nl
    + 'c:\test\teapro9.exe yourprog.tea' + nl
    + 'where both files are in the directory c:\test. '
    + 'Then use the Start Menu or the Short Cut '
    + 'to run this Teapro9 interpreter Program with the '
    + 'name of the Teapro program as a parameter as above. '
    + 'Click on the Start Program button to start the Teapro program.';

    if b_more then b_more := fnb_more(sz);

end; { sub_help_running }


procedure TForm1.sub_comm_dchs;
{ updated 2003/04/26 }
{ to perform the command DCH$ }
var
    sz : string;
    i_parm2, i_parm3 : integer;
begin
    { 1234567890123456789012345 }
    { DCHS 00101n,00099n,00032n }

    { get parm2 and parm3 }
    i_parm2 := fni_decimal_eval(13);
    i_parm3 := fni_decimal_eval(20);

    if (i_parm2 < 0) then i_parm3 := 0;
    if (i_parm2 > 256) then i_parm3 := 0;

    if (i_parm3 < 0) then i_parm3 := 0;

    if (i_parm3 > fi_max_length) then
    begin
        sub_program_error('string too long');
    end
    else
    begin
        { make the string }
        sz := StringOfChar(Chr(i_parm2), i_parm3);

        sub_store_string(6, sz);
    end;
end; { sub_comm_dchs }


function TForm1.fnb_comm_dift : boolean;
{ updated 2003/09/15 }
{ perform command DIFT and DWHI }
var
    char_op : char;
    e_parm1, e_parm2 : double;
begin
    { get next Teapro program line }
    fs_tpline := fsa_tpline[fi_tpline];

    { 123456789012345678901 }
    { DWHI 12345n>>12345n,3 }
    e_parm1 := fnd_decimal_eval(6);
    e_parm2 := fnd_decimal_eval(14);

    Result := false;

    char_op := fs_tpline[21];

    Case char_op of
        '1' : if (e_parm1 = e_parm2) then Result := true;
        '2' : if (e_parm1 <> e_parm2) then Result := true;
        '3' : if (e_parm1 < e_parm2) then Result := true;
        '4' : if (e_parm1 > e_parm2) then Result := true;
        '5' : if (e_parm1 >= e_parm2) then Result := true;
        '6' : if (e_parm1 <= e_parm2) then Result := true;
    end;
end; { fnb_comm_dift }


procedure TForm1.sub_comm_dset;
{ updated 2007/07/23 }
{ 2007/07/08, 2007/05/06, 2007/04/28, 2007/04/14, 2004/04/21 }
{ perform command DSET }
var
    c_1 : comp;
    c_2 : comp;
    e_answer : double;
    e_term : double;
    char_op : char;
    iy, iz : integer;
    b_loop : boolean;
begin
    { dset 00201n=+00001n*00301p-00302p/00303p*00005n; }
    { 12345678901234567890123456789012345678901234567890 }

    fb_error := false;
    e_answer := 0;
    iz := 13;
    b_loop := true;

    while b_loop do
    begin
        { evaluate the decimal, iz is where the operator is }
        iy := StrToIntDef(Copy(fs_tpline, Succ(iz), 5), -1);

        if (iy = -1) then
        begin
            sub_program_error('bad variable link');
        end
        else
        begin
            if (fs_tpline[iz + 6] = 'D')
                then e_term := fea_var[iy + fi_delta_d]
            else if (fs_tpline[iz + 6] = 'G')
                then e_term := fea_var[iy]
            else e_term := iy;

            char_op := fs_tpline[iz];

            case char_op of

                '%' : { modulus }
                begin
                    { the sign of e_answer prevails }
                    c_1 := e_answer;
                    c_2 := e_term;

                    if (c_2 > 0) then
                    begin
                        { find mod }
                        e_answer := c_1 - Int(c_1 / c_2) * c_2;
                    end
                    else sub_program_error('zero mod');
                end;

                '*' : e_answer := e_answer * e_term;

                '+' : e_answer := e_answer + e_term;

                '-' : e_answer := e_answer - e_term;

                '/' : { regular divide }
                begin
                    { division using decimals }
                    if (e_term <> 0) then e_answer := e_answer / e_term
                    else sub_program_error('zero divide');
                end;

                '\' : { integer divide }
                begin
                    c_1 := e_answer;
                    c_2 := e_term;

                    if (c_2 <> 0) then e_answer := Int(c_1 / c_2)
                    else sub_program_error('zero integer divide');
                end;

                '^' : { exponentiation }
                begin
                    { if e_answer negative then e_term must be integer }
                    if (e_answer < 0) and (e_term <> floor(e_term)) then
                        e_answer := abs(e_answer);

                    if (e_answer = 0) or (e_term = 0) then
                    begin
                        e_answer := 1;
                        e_term := 1;
                    end;
                    e_answer := power(e_answer, e_term);
                end;

                '@' : { round to number of places }
                begin
                    c_2 := power(10, int(abs(e_term) + 0.001));
                    c_1 := e_answer * c_2 + 0.499;
                    e_answer := c_1 / c_2;
                end;

                '?' : { truncate to number of places }
                begin
                    c_2 := power(10, int(abs(e_term) + 0.001));
                    c_1 := int(e_answer * c_2 + 0.001);
                    e_answer := c_1 / c_2;
                end;
            end;
        end;

        Inc(iz, 7);
        if fb_error or (fs_tpline[iz] = ';') then b_loop := false;
    end;

    { store the answer }
    if not fb_error then sub_store_decimal(6, e_answer);
end; { sub_comm_dset }


procedure TForm1.sub_comm_dfac;
{ updated 2007/01/19, 2005/04/29, 2005/03/22, 2004/10/11 }
{ find lowest factor greater than 1 }
var
	d_parm2 : double;
	d_try : double;
	d_divisor : double;
    c_answer : comp;
    cz : comp;
    b_error : boolean;
	b_loop : boolean;
begin
    { 123456789012345678 }
    { DFAC 00101d,00102d }
    cz := fnd_decimal_eval(13);
    d_parm2 := cz;
    Application.ProcessMessages;

    b_error := false;
    b_loop := true;

    if (d_parm2 < 1) or (d_parm2 >= Power(10, 16)) then
    begin
        { number out of range }
        sub_program_error('dfac range is > 0 and < 9.0E15');
        b_error := true;
        b_loop := false;
    end;

    if b_loop then
    begin
        d_divisor := 1;
        if (d_parm2 < 4) then b_loop := false;
    end;

    if b_loop then
    begin
        { is c_answer even }
        c_answer := d_parm2 / 2;

        if (d_parm2 = c_answer * 2) then
        begin
            { even number not prime }
            b_loop := false;
            d_divisor := 2;
        end;

        d_try := 3;
    end;

    while b_loop and fb_program_loop do
    begin
        { dfac }
        c_answer := d_parm2 / d_try;

        if (d_parm2 <> c_answer * d_try) then
        begin
            d_try := d_try + 2;
            { prime? }
	    	if (sqr(d_try) > d_parm2) then b_loop := false;
        end
        else
        begin
            { not prime }
			d_divisor := d_try;
            b_loop := false;
        end;
    end;

    if not b_error then sub_store_decimal(6, d_divisor);
end; { sub_comm_dfac }


procedure TForm1.sub_comm_dfak;
{ updated 2007/03/04, 2007/01/20 }
{ 2007/01/19, 2007/01/18, 2005/04/29, 2005/03/22, 2004/10/11 }
{ find lowest factor of parm2 + parm3 * 9quadrillion }
var
    d_1quadpart : double;
    d_1quadmult : double;
    d_1quadnum : double;
    d_factor : double;
    d_root : double;
	d_divisor : double;
    d_modulus : double;
    i_loop : integer;
    cz : comp;
    dz : double;
begin
    { 1234567890123456789012345 }
    { DFAK 00101d,00102d,00103d }
                { 1234567890123456 }
    d_1quadnum := 1000000000000000.0;
    d_factor := 1;
    i_loop := 1;
    Application.ProcessMessages;

    cz := fnd_decimal_eval(13);
    d_1quadpart := Abs(cz);

    cz := fnd_decimal_eval(20);
    d_1quadmult := Abs(cz);

    { d_1quadnum is factored by 2 }
    dz := fnd_modulus(d_1quadpart, 2);
    if (dz = 0) then
    begin
        d_factor := 2;
        inc(i_loop);
    end;

    if (i_loop = 1) then
        d_root := sqrt(d_1quadpart + d_1quadmult * d_1quadnum);

    d_divisor := 3;

    while (i_loop = 1) do
    begin
        d_modulus := fnd_modulus(fnd_modulus(d_1quadpart, d_divisor)
        + d_1quadmult * fnd_modulus(d_1quadnum, d_divisor), d_divisor);

        if (d_modulus = 0) then
        begin
            Inc(i_loop);
            d_factor := d_divisor;
        end
        else
        begin
            d_divisor := d_divisor + 2;
            if (d_divisor > d_root) then Inc(i_loop);
        end;
    end;

    sub_store_decimal(6, d_factor);
end; { sub_comm_dfak }


procedure TForm1.sub_comm_dpow;
{ updated 2007/07/23, 2007/07/08, 2004/04/21 }
var
    d_number : double;
    d_power : double;
    d_result : double;
begin
    { 1234567890123456789012345 }
    { DPOW 00101d,00102d,12345d }
    d_number := fnd_decimal_eval(13);
    d_power := fnd_decimal_eval(20);

    { if d_number negative then d_power must be integer }
    if (d_number < 0) and (d_power <> floor(d_power)) then
        d_number := abs(d_number);

    if (d_number = 0) or (d_power = 0) then
    begin
        d_number := 1;
        d_power := 1;
    end;

    d_result := Power(d_number, d_power);

    sub_store_decimal(6, d_result);
end; { sub_comm_dpow }


procedure TForm1.sub_comm_dsin(const pbyte_1 : byte);
{ updated 2003/09/14 }
var
    b_negative : boolean;
    dz : double;
    cz : comp;
    e_parm2 : double;
    d_result : double;
    b_error : boolean;
begin
    { 123456789012345678 }
    { DSIN 00101d,00102d }
    e_parm2 := fnd_decimal_eval(13);

    b_error := false;

    if (pbyte_1 = 1) then
    begin
        { drou round }
        if (e_parm2 < 0) then
        begin
            b_negative := true;
            e_parm2 := - e_parm2;
        end
        else b_negative := false;

        cz := e_parm2;
        if ((e_parm2 - cz) = 0.5) then cz := cz + 1;

        if b_negative then cz := - cz;

        d_result := cz;
    end
    else if (pbyte_1 = 2) then d_result := Int(e_parm2) { dtru truncate }
    else if (pbyte_1 = 3) then d_result := Sin(e_parm2) { dsin sine }
    else if (pbyte_1 = 4) then
    begin
        { darc finding arcsine }
        if (e_parm2 = 1) then d_result := PI / 2
        else if (e_parm2 = -1) then d_result := -PI / 2
        else if (e_parm2 < 1) and (e_parm2 > -1) then
            d_result := ArcTan(e_parm2/sqrt(1-sqr(e_parm2)))
        else
        begin
            sub_program_error('bad numbers in DSIN');
            b_error := true;
        end;
    end
    else if (pbyte_1 = 5) then
    begin
        { dlog finding log10 }
        if (e_parm2 > 0) then d_result := Log10(e_parm2)
        else b_error := true;
    end;

    if not b_error then sub_store_decimal(6, d_result);
end; { sub_comm_dsin }


procedure TForm1.sub_comm_dtos(const pbyte_1 : byte);
{ updated 2006/05/02, 2004/09/25 }
{ perform decimal to string DTO$, DED$ }
var
    e_number : double;
    i_length : integer;
    i_decimals : integer;

    i_dot : integer;
    i_right : integer;
    s_number : string;
    i_long : integer;
    iy, iz : integer;
    b_process : boolean;
begin
    { do we need to put commas in, pbyte_1=1 means DED$ }
    { 12345678901234567890123456789012 }
    { DTO$ 00101n,00401p,00010n,00011n }
    e_number := fnd_decimal_eval(13);
    i_length := fni_decimal_eval(20);
    i_decimals := fni_decimal_eval(27);

    if (i_length < 0) then i_length := 0;
    if (i_decimals < 0) then i_decimals := 0;
    if (i_decimals > 16) then i_decimals := 16;
    if (i_decimals = 0) and (i_length = 0) then i_decimals := 16;

    { change number to string }
    if (pbyte_1 = 1) then
    begin
        { with commas }
        s_number := Trim(FloatToStrF(e_number, ffNumber, 16, i_decimals))
    end
    else
    begin
        { without commas }
        s_number := Trim(FloatToStrF(e_number, ffFixed, 16, i_decimals));
    end;

    b_process := true;

    { do we have an E for exponential notation }
    if (Pos('E', s_number) > 0) then
    begin
        { add leading blanks if not long enought }
        if (i_length > Length(s_number)) then
        begin
            iz := i_length - Length(s_number);
            s_number := StringOfChar(' ', iz) + s_number;
        end;
        b_process := false;
    end;

    if b_process then
    begin
        { make sure we have a decimal }
        if (Pos('.', s_number) = 0) then
            s_number := s_number + '.';

        { remove trailing zeros }
        iz := Length(s_number);
        while (s_number[iz] = '0') do Dec(iz);
        s_number := Copy(s_number, 1, iz);

        i_dot := Pos('.', s_number);
        i_long := Length(s_number);

        i_right := i_long - i_dot;

        if (i_decimals > i_right) and (i_length > i_long) then
        begin
            iz := i_length - i_long;
            iy := i_decimals - i_right;
            if (iz > iy) then iz := iy;

            { add zeros on the right side }
            s_number := s_number + StringOfChar('0', iz);
        end;

        { remove a trailing decimal if needed }
        i_long := Length(s_number);
        if (s_number[i_long] = '.') then
            s_number := Copy(s_number, 1, Pred(i_long));

        { make the string i_length long by adding blanks to the left }
        if (Length(s_number) < i_length) then
        begin
            iz := i_length - Length(s_number);
            s_number := StringOfChar(' ', iz) + s_number;
        end;
    end;

    sub_store_string(6, s_number);
end; { sub_comm_dtos }


procedure TForm1.sub_comm_dtof;
{ updated 2004/05/17 }
{ decimal to field format ie. +00000137 }
var
    e_parm2 : double;
    i_parm3 : integer;
    i_long : integer;
    s_field : string;
    co_number : comp;
    iz : integer;
    b_negative : boolean;
begin
    fb_error := false;

    { 1234567890123456789012345 }
    { DPK$ 00101n,00401p,00010n }
    e_parm2 := fnd_decimal_eval(13);
    i_parm3 := fni_decimal_eval(20);

    if (i_parm3 < 2) then sub_program_error('bad length DTOF');

    if not fb_error then
    begin
        co_number := e_parm2;

        if (co_number < 0) then
        begin
            b_negative := true;
            co_number := - co_number;
        end
        else b_negative := false;

        s_field := Trim(FloatToStrF(co_number, ffGeneral, 16, 4));
    end;

    { is it too long }
    if not fb_error then
        if (Length(s_field) > Pred(i_parm3)) then
            sub_program_error('bad length DTOF');

    if not fb_error then
    begin
        { make left part of string zero-filled }
        s_field := StringOfChar('0', i_parm3 - Length(s_field))
            + s_field;

        if b_negative then s_field[1] := '-'
        else s_field[1] := '+';

        sub_store_string(6, s_field);
    end;
end; { sub_comm_dtof }


procedure TForm1.sub_comm_dpks;
{ updated 2003/10/05 }
{ perform decimal to packed format zero filled to string DPK$ }
{ packed format is also called BCD or binary coded decimal }
var
    e_parm2 : double;
    i_parm3 : integer;
    i_long : integer;
    s_packed : string;
    co_number : comp;
    iz : integer;
    b_negative : boolean;
begin
    fb_error := false;

    { 1234567890123456789012345 }
    { DPK$ 00101n,00401p,00010n }
    e_parm2 := fnd_decimal_eval(13);
    i_parm3 := fni_decimal_eval(20);

    if (i_parm3 < 1) then sub_program_error('bad numbers DPK$');

    if not fb_error then
    begin
        co_number := e_parm2;

        if (co_number < 0) then
        begin
            b_negative := true;
            co_number := - co_number;
        end
        else b_negative := false;

        s_packed := Trim(FloatToStrF(co_number, ffGeneral, 16, 4));
    end;

    { is it too long }
    if not fb_error then
        if (Length(s_packed) > i_parm3) then
            sub_program_error('bad numbers DPK$');

    if not fb_error then
    begin
        { make left part of string zero-filled }
        s_packed := StringOfChar('0', i_parm3 - Length(s_packed))
            + s_packed;

        if b_negative then
        begin
            { change to packed format }
            i_long := Length(s_packed);

            { 1 at 49 changes to J at 74 }
            iz := Ord(s_packed[i_long]) + 25;

            { I is 73 and a right brace is 125 }
            if (iz = 73) then iz := 125;
            s_packed[i_long] := Chr(iz);
        end;

        sub_store_string(6, s_packed);
    end;
end; { sub_comm_dpks }


procedure TForm1.sub_comm_dtoi(const pbyte_1 : byte);
{ updated 2007/06/16, 2004/02/02 }
{ put or add a decimal into a pointed to address }
var
    i_parm1 : integer;
    e_parm2 : double;
begin
    { 123456789012345678 }
    { DTOI 00701D,00401D }
    { ADDI 00701d,00401d }
    i_parm1 := fni_decimal_eval(6);
    e_parm2 := fnd_decimal_eval(13);

    { validate and put }
    { put the value into the array at the index }
    if (i_parm1 >= 1) and (i_parm1 <= fi_max_darray) then
    begin
        if (pbyte_1 = 1) then fea_array[i_parm1] := e_parm2
        else fea_array[i_parm1] := fea_array[i_parm1] + e_parm2;
    end
    else sub_program_error('bad index=' + IntToStr(i_parm1));
end; { sub_comm_dtoi }


procedure TForm1.sub_comm_itod;
{ updated 2007/06/16, 2004/01/24 }
{ get a decimal by an index from an array }
var
    i_parm2 : integer;
begin
    { 123456789012345678 }
    { ITOD 00701D,00401D }
    i_parm2 := fni_decimal_eval(13);

    { get the decimal from the array by index }

    if (i_parm2 >= 1) and (i_parm2 <= fi_max_darray) then
        sub_store_decimal(6, fea_array[i_parm2])
    else sub_program_error('bad index=' + IntToStr(i_parm2));
end; { sub_comm_itod }


procedure TForm1.sub_comm_sdat;
{ updated 2002/09/05 }
var
    s_date : string;
begin
    { 12345678901 }
    { SDAT 00601D }
    {      s_date }
    s_date := UpperCase(FormatDateTime('dd-mmm-yyyy hh:nn:ss', Now))
    + ' ' + FormatDateTime('yyyymmddhhnnss', Now);

    sub_store_string(6, s_date);
end; { sub_comm_sdat }


function TForm1.fnb_comm_sift : boolean;
{ updated 2000/01/01 }
var
    char_op : char;
    s_parm1, s_parm2 : string;
begin
    { get next Teapro program line }
    fs_tpline := fsa_tpline[fi_tpline];

    { 123456789012345678901 }
    { $IFT 00101n<>00201n,1 }

    { get s1 }
    s_parm1 := fns_string_eval(6);

    { get s2 }
    s_parm2 := fns_string_eval(14);

    Result := false;
    char_op := fs_tpline[21];

    Case char_op of
        '1' : if (s_parm1 = s_parm2) then Result := true;
        '2' : if (s_parm1 <> s_parm2) then Result := true;
        '3' : if (s_parm1 < s_parm2) then Result := true;
        '4' : if (s_parm1 > s_parm2) then Result := true;
        '5' : if (s_parm1 >= s_parm2) then Result := true;
        '6' : if (s_parm1 <= s_parm2) then Result := true;
    end;
end; { fnb_comm_sift }


procedure TForm1.sub_comm_sout(const pbyte_1 : byte);
{ updated 2000/01/01 }
{ perform the $OUT command }
var
    s_parm1 : string;
begin
    { 12345678901 }
    { $OUT 00101n }
    { $OUT "string" }

    { get the output string }
    s_parm1 := fns_string_parse(Copy(fs_tpline, 6, 200));

    { show in memo_show }
    sub_memo_show(s_parm1, pbyte_1);
end; { sub_comm_sout }


procedure TForm1.sub_comm_sisd;
{ updated 2004/09/25 }
{ $ISD, returns 1 if the string is a decimal value }
var
    i_result : integer;
    ez : double;
    sz : string;
    b_error : boolean;
begin
    { 123456789012345678 }
    { $ISD 00901D,00101S }
    sz := Trim(fns_string_eval(13));

    sub_double_from_string(sz, ez, b_error);

    if b_error then i_result := 2
    else i_result := 1;

    sub_store_decimal(6, i_result);
end; { sub_comm_sisd }


procedure TForm1.sub_comm_stod;
{ updated 2003/11/23 }
{ perform the command $TOD, string to decimal }
var
    b_error : boolean;
    e_number : double;
    s_number : string;
begin
    { 123456789012345678 }
    { $TOD 00901D,00101S }
    s_number := fns_string_eval(13);

    sub_double_from_string(s_number, e_number, b_error);

    if not b_error then
        sub_store_decimal(6, e_number)
    else sub_program_error('$TOD not number="' + s_number + '"');
end; { sub_comm_stod }


procedure TForm1.sub_comm_spkd;
{ updated 2005/11/02, 2003/10/05 }
{ perform the command $PKD, packed formatted string to decimal }
{ packed format is also called BCD or binary coded decimal }
var
    e_number : double;
    s_parm3 : string;
    i_long : integer;
    b_negative : boolean;
    b_error : boolean;
    i_good : integer;
    iz : integer;
begin
    { 1234567890123456789012345 }
    { $PKD 00901D,00101S,00101S }
    s_parm3 := fns_string_eval(20);
    s_parm3 := Trim(s_parm3);

    i_long := Length(s_parm3);
    if (i_long = 0) then
    begin
        s_parm3 := '0';
        i_long := 1;
    end;

    { what is the last char and do we need to change it }
    iz := Ord(s_parm3[i_long]);

    { 48 is 0 and 57 is 9 }
    b_negative := true;
    if (iz >= 48) and (iz <= 57) then b_negative := false

    { 65 is A and 73 is I }
    else if (iz >= 65) and (iz <= 73) then
    begin
        b_negative := false;
        iz := iz - 16;
        s_parm3[i_long] := Chr(iz);
    end

    { 74 is J and 82 is R }
    else if (iz >= 74) and (iz <= 82) then
    begin
        b_negative := true;
        iz := iz - 25;
        s_parm3[i_long] := Chr(iz);
    end

    { a right brace is 125 which is negative zero }
    else if (iz = 125) then
    begin
        b_negative := true;
        s_parm3[i_long] := '0';
    end

    { a left brace is 123 which is positive zero }
    else if (iz = 123) then
    begin
        b_negative := false;
        s_parm3[i_long] := '0';
    end;

    b_error := false;
    if (i_long > 15) then b_error := true;

    for iz := 1 to i_long do
    begin
        if (s_parm3[iz] < '0') or (s_parm3[iz] > '9') then
            b_error := true;
    end;

    i_good := 2;
    e_number := 0;

    if not b_error then
    begin
        i_good := 1;
        e_number := StrToFloat(s_parm3);
        if b_negative then e_number := - e_number;
    end;

    sub_store_decimal(6, i_good);
    if not b_error then sub_store_decimal(13, e_number);
end; { sub_comm_spkd }


procedure TForm1.sub_comm_stoi(const pbyte_1 : byte);
{ updated 2007/06/16, 2006/06/11, 2006/06/09, 2004/01/24 }
{ perform $toi, string to an array by index }
var
    i_parm1 : integer;
    s_parm2 : string;
begin
    { 123456789012345678 }
    { $TOI 00401D,00101S }
    i_parm1 := fni_decimal_eval(6);
    s_parm2 := fns_string_parse(Copy(fs_tpline, 13, 200));

    { validate and put }
    { put the string into the string array by index }
    if (i_parm1 >= 1) and (i_parm1 <= fi_max_sarray) then
        fsa_array[i_parm1] := s_parm2
    else sub_program_error('bad index=' + IntToStr(i_parm1));
end; { sub_comm_stoi }


procedure TForm1.sub_comm_itos;
{ updated 2007/06/16, 2004/01/24 }
{ ito$, index to string }
var
    { 05-SEP-2002 }
    i_parm2 : integer;
begin
    { 123456789012345678 }
    { ITO$ 00101S,00401D }
    i_parm2 := fni_decimal_eval(13);

    { put the string from the string array by index into a string variable }
    { the string variable to put the string into may need fi_delta_s }
    if (i_parm2 >= 1) and (i_parm2 <= fi_max_sarray) then
        sub_store_string(6, fsa_array[i_parm2])
    else sub_program_error('bad index=' + IntToStr(i_parm2));
end; { sub_comm_itos }


procedure TForm1.sub_comm_array(const pbyte_1 : byte);
{ updated 2007/06/16, 2004/01/24 }
{ either zero decimal array or blank string array }
var
    iz : integer;
begin
    if (pbyte_1 = 1) then
    begin
        { ARRZ }
        for iz := 1 to fi_max_darray do fea_array[iz] := 0;
    end
    else
    begin
        { ARRB }
        for iz := 1 to fi_max_sarray do fsa_array[iz] := '';
    end;
end; { sub_comm_array }


procedure TForm1.sub_comm_sset;
{ updated 2002/11/22 }
{ perform the command $SET }
var
    s_string : string;
begin
    { 1234567890123456789012345 }
    { $SET 00101n,00201n+00202s }
    s_string := fns_string_parse(Copy(fs_tpline, 13, 99999));

    sub_store_string(6, s_string);
end; { sub_comm_sset }


procedure TForm1.sub_comm_sapp;
{ updated 2003/10/10 }
{ append a string to another string }
var
    s_parm1, s_parm2 : string;
begin
    { 123456789012345678 }
    { $APP 00101S,00401D }

    { get parm1 }
    s_parm1 := fns_string_eval(6);

    { get parm2 }
    s_parm2 := fns_string_parse(Copy(fs_tpline, 13, 99999));

    if (Length(s_parm1) + Length(s_parm2) > fi_max_length) then
    begin
        sub_program_error('too long');
    end
    else sub_store_string(6, s_parm1 + s_parm2);
end; { sub_comm_sapp }


procedure TForm1.sub_comm_srep;
{ updated 2003/10/09 }
{ perform the command $REP to replace bytes in a string }
var
    iz : integer;
    i_parm2 : integer;
    s_parm1, s_parm3 : string;
    i_long1, i_long3 : integer;
    b_error : boolean;
begin
    { 1234567890123456789012345 }
    { $REP 00101S,00401D,00201S }

    { get parm1 }
    s_parm1 := fns_string_eval(6);

    { get parm2 }
    i_parm2 := fni_decimal_eval(13);

    { get parm3 }
    s_parm3 := fns_string_eval(20);

    i_long1 := Length(s_parm1);
    i_long3 := Length(s_parm3);

    b_error := false;
    if (i_parm2 < 1) or (i_parm2 > i_long1) then b_error := true;
    if ((i_parm2 + i_long3 - 1) > i_long1) then b_error := true;

    if not b_error then
    begin
        iz := 1;
        while (iz <= i_long3) do
        begin
            s_parm1[i_parm2 + iz - 1] := s_parm3[iz];
            Inc(iz);
        end;

        sub_store_string(6, s_parm1);
    end
    else sub_program_error('bad $REP');
end; { sub_comm_srep }


procedure TForm1.sub_comm_sswp;
{ updated 2007/01/19, 2005/04/29, 2005/03/22, 2004/06/29 }
{ string swap in s_parm1 replace each s_parm2 with s_parm3 }
var
    s_parm1, s_parm2, s_parm3 : string;
    i_long1, i_long2, i_long3 : integer;
    i_byte : integer;
    i_diff : integer;
    b_loop : boolean;
    b_changed : boolean;
begin
    { 1234567890123456789012345 }
    { $SWP 00101S,00401S,00201S }
    { get parm1 }
    s_parm1 := fns_string_eval(6);

    { get parm2 }
    s_parm2 := fns_string_eval(13);

    { get parm3 }
    s_parm3 := fns_string_eval(20);

    i_long1 := Length(s_parm1);
    i_long2 := Length(s_parm2);
    i_long3 := Length(s_parm3);
    i_diff := i_long3 - i_long2;

    b_changed := false;
    b_loop := true;

    if (i_long1 = 0) or (i_long2 = 0)
    or (i_long1 < i_long2) then b_loop := false;

    i_byte := 1;

    while b_loop do
    begin
        if (Copy(s_parm1, i_byte, i_long2) = s_parm2) then
        begin
            if ((Length(s_parm1) + i_diff) > fi_max_length) then
            begin
                b_loop := false;
                b_changed := false;
                sub_program_error('too long');
            end
            else
            begin
                Application.ProcessMessages;
                Delete(s_parm1, i_byte, i_long2);
                if (i_long3 > 0) then Insert(s_parm3, s_parm1, i_byte);

                i_byte := i_byte + i_long3 - 1;
                b_changed := true;
            end;
        end;

        Inc(i_byte);
        if (i_byte > Length(s_parm1)) then b_loop := false;
    end;

    if b_changed then sub_store_string(6, s_parm1);
end; { sub_comm_sswp }


procedure TForm1.sub_comm_sins;
{ updated 2003/10/09 }
{ perform the command $INS to insert a string into another }
var
    { 26-APR-2003 }
    s_parm1, s_parm3 : string;
    i_parm2 : integer;
    i_long1, i_long3 : integer;
    s_result : string;
    b_error : boolean;
begin
    { 1234567890123456789012345 }
    { $INS 00101S,00401D,00201S }

    { get parm1 }
    s_parm1 := fns_string_eval(6);

    { get parm2 which is where to insert }
    i_parm2 := fni_decimal_eval(13);

    { get parm3 which is the string to insert }
    s_parm3 := fns_string_eval(20);

    b_error := false;
    i_long1 := Length(s_parm1);
    i_long3 := Length(s_parm3);

    if ((i_long1 + i_long3) > fi_max_length) then b_error := true
    else if (i_parm2 > (i_long1 + 1)) then b_error := true
    else if (i_parm2 < 1) then b_error := true
    else if (i_long1 = 0) then s_result := s_parm3
    else if (i_long3 = 0) then s_result := s_parm1
    else if (i_parm2 = (i_long1 + 1)) then s_result := s_parm1 + s_parm3
    else if (i_parm2 = 1) then s_result := s_parm3 + s_parm1
    else
    begin
        s_result := s_parm1;
        Insert(s_parm3, s_result, i_parm2);
    end;

    if b_error then sub_program_error('bad $ins')
    else sub_store_string(6, s_result);
end; { sub_comm_sins }


procedure TForm1.sub_comm_sdel;
{ updated 2002/09/05 }
{ perform the command $DEL to delete a string from another string }
var
    s_parm1 : string;
    i_parm2, i_parm3 : integer;
begin
    { 1234567890123456789012345 }
    { $DEL 00101S,00401D,00402D }

    { get parm1 }
    s_parm1 := fns_string_eval(6);

    { get parm2 which is where to begin to delete }
    i_parm2 := fni_decimal_eval(13);

    { get parm3 which is how many bytes to delete }
    i_parm3 := fni_decimal_eval(20);

    { delete }
    if (i_parm2 > 0) and (i_parm2 <= Length(s_parm1)) then
    begin
        Delete(s_parm1, i_parm2, i_parm3);

        sub_store_string(6, s_parm1);
    end
    else sub_program_error('bad number $DEL');
end; { sub_comm_sdel }


procedure TForm1.sub_comm_slen(const pbyte_1 : byte);
{ updated 2006/06/02, 2002/09/05 }
{ find length or hash of string }
var
    s_parm2 : string;
    i_long : integer;
    i_byte : integer;
    ix, iy, iz : integer;
    d_result : double;
begin
    { 123456789012345678 }
    { $LEN 00401n,00101n }

    { get the string whose length we want }
    s_parm2 := fns_string_eval(13);
    i_long := Length(s_parm2);

    { 1=$LEN }
    if (pbyte_1 = 1) then d_result := i_long
    else
    begin
        { 2=$HSH }
        ix := 0;
        iy := 0;

        for i_byte := 1 to i_long do
        begin
            iz := Ord(s_parm2[i_byte]) + 1;
            { 1,000,000,000 }
            ix := (ix + iz) mod 1000000000;
            { 701 is prime, 1,000,000 }
            iy := (iy + ((i_byte - 1) mod 701 + 1) * iz) mod 1000000;
        end;
        { 1,000,000 }
        d_result := ix * 1000000.0 + iy;
    end;

    { store the string length }
    sub_store_decimal(6, d_result);
end; { sub_comm_slen }


procedure TForm1.sub_comm_sfix(const pbyte_1 : byte);
{ updated 2004/11/06 }
{ make a string in op3 upper or lower case put in op2 }
var
    iz : integer;
    sz : string;
begin
    { 123456789012345678 }
    { $CLO 00102S,00101S }

    { get the string we want to fix }
    sz := fns_string_eval(13);

    {   $CLO = 1
        $CUP = 2
        $BES = 3
        $TRB = 4
        $TRL = 5
        $TRR = 6
        $TLO = 7
        $TUP = 8
    }

    if (pbyte_1 = 1) then sz := LowerCase(sz)
    else if (pbyte_1 = 2) then sz := UpperCase(sz)
    else if (pbyte_1 = 3) then sz := fns_blank_escapes(sz)
    else if (pbyte_1 = 4) then sz := Trim(sz)
    else if (pbyte_1 = 5) then sz := TrimLeft(sz)
    else if (pbyte_1 = 6) then sz := TrimRight(sz)
    else if (pbyte_1 = 7) then sz := Trim(LowerCase(sz))
    else if (pbyte_1 = 8) then sz := Trim(UpperCase(sz));

    { store the new string }
    sub_store_string(6, sz);
end; { sub_comm_sfix }


procedure TForm1.sub_comm_ssor;
{ updated 2007/01/19, 2005/04/29, 2005/03/22, 2003/09/15 }
{ string sort by lengths }
var
    s_parm2 : string;
    i_parm3 : integer;
    s_1, s_2 : string;
    i_1, i_2 : integer;
    i_length : integer;
    iz : integer;
    b_sort : boolean;
begin
    fb_error := false;

    { 1234567890123456789012345 }
    { $SOR 00401S,00001S,00101D }

    { get the sort length }
    i_parm3 := fni_decimal_eval(20);

    { get the string we want to sort }
    s_parm2 := fns_string_eval(13);

    b_sort := true;
    i_length := Length(s_parm2);

    if (i_length mod i_parm3 > 0) then fb_error := true;
    if (i_length <= i_parm3) then b_sort := false;

    if b_sort and not fb_error then
    begin
        i_1 := 1;
        while (i_1 < i_length) do
        begin
            { $sor }
            Application.ProcessMessages; 

            s_1 := Copy(s_parm2, i_1, i_parm3);
            i_2 := i_1 + i_parm3;

            while (i_2 <= i_length) do
            begin
                s_2 := Copy(s_parm2, i_2, i_parm3);

                if (s_1 > s_2) then
                begin
                    { put s_2 into i_1 the position }
                    for iz := 1 to i_parm3 do
                    begin
                        s_parm2[i_1 + iz - 1] := s_2[iz];
                        s_parm2[i_2 + iz - 1] := s_1[iz];
                    end;

                    s_1 := s_2;
                end;

                Inc(i_2, i_parm3);
            end;

            Inc(i_1, i_parm3);
        end;
    end;

    if fb_error then sub_program_error('bad numbers $SOR')
    else
    begin
        { store the sorted string }
        sub_store_string(6, s_parm2);
    end;
end; { sub_comm_ssor }


procedure TForm1.sub_comm_slok;
{ updated 2002/09/02 }
{ lookup string op5 in string op4 starting at op3 and put in op2 }
var
    s_parm2, s_parm4 : string;
    i_parm3 : integer;
    i_long4, i_long2 : integer;
    i_max2 : integer;
    i_spot : integer;
    iw, ix, iz : integer;
    b_loop : boolean;
    b_match : boolean;
    b_process : boolean;
begin
    { 12345678901234567890123456789012 }
    { $LOK 00401D,00001S,00001N,00102S }

    { get the string we want to find }
    s_parm4 := fns_string_eval(27);

    { get the starting point }
    i_parm3 := fni_decimal_eval(20);

    { get the string we want to look in }
    s_parm2 := fns_string_eval(13);

    b_process := true;
    i_long4 := Length(s_parm4);
	i_long2 := Length(s_parm2);

    i_max2 := Succ(i_long2 - i_long4);

    if (i_parm3 < 1) or (i_parm3 > i_max2) then b_process := false;
    if (i_long4 = 0) or (i_long4 > i_long2) then b_process := false;

    i_spot := 0;

    if b_process then
    begin
		{ ix is what we are looking for }
		ix := i_parm3;

        b_match := false;
        b_loop := true;

        while b_loop do
        begin
            if (s_parm4[1] = s_parm2[ix]) then
            begin
                b_match := true;
                iw := Pred(ix);

                for iz := 2 to i_long4 do
                begin
                    if (s_parm4[iz] <> s_parm2[iw + iz])
                    then b_match := false;
                end;

                if b_match then
                begin
                    b_loop := false;
                    i_spot := ix;
                end;
            end;

            if not b_match then
            begin
                Inc(ix);
                if (ix > i_max2) then b_loop := false;
            end;
        end;
    end;


    { store the find answer }
    sub_store_decimal(6, i_spot);
end; { sub_comm_slok }


procedure TForm1.sub_comm_scnt;
{ updated 2003/11/07 }
{ find count of occurrences of string in other string }
var
    s_parm2, s_parm3 : string;
    i_long3, i_long2 : integer;
    i_max : integer;
    i_count : integer;
    iw, ix, iz : integer;
    b_loop : boolean;
    b_match : boolean;
    b_process : boolean;
begin
    { 1234567890123456789012345 }
    { $CNT 00401D,00001S,00102S }

    { get the string we want to look in }
    s_parm2 := fns_string_eval(13);

    { get the string we want to find }
    s_parm3 := fns_string_eval(20);

    b_process := true;
    i_long3 := Length(s_parm3);
	i_long2 := Length(s_parm2);

    if (i_long3 = 0) or (i_long3 > i_long2) then b_process := false;

    i_count := 0;

    if b_process then
    begin
		{ ix is where we are looking }
		ix := 1;
        { i_max is the maximum that ix can be }
        i_max := Succ(i_long2 - i_long3);
        b_match := false;
        b_loop := true;

        while b_loop do
        begin
            if (s_parm3[1] = s_parm2[ix]) then
            begin
                b_match := true;
                iw := Pred(ix);

                for iz := 2 to i_long3 do
                begin
                    if (s_parm3[iz] <> s_parm2[iw + iz])
                    then b_match := false;
                end;

                if b_match then
                begin
                    Inc(i_count);
                    { so that occurrences cannot overlap }
                    ix := ix + Pred(i_long3);
                end;
            end;

            Inc(ix);
            if (ix > i_max) then b_loop := false;
        end;
    end;

    { store the count }
    sub_store_decimal(6, i_count);
end; { sub_comm_scnt }


procedure TForm1.sub_comm_sbak;
{ updated 2002/09/05 }
{ lookup string op5 in string op4 starting at op3 and put in op2 }
var
    s_parm2, s_parm4 : string;
    i_parm3 : integer;
    i_long4, i_long2 : integer;
    ix, iz : integer;
    b_loop : boolean;
    b_match : boolean;
    b_process : boolean;
begin
    { 12345678901234567890123456789012 }
    { $BAK 00401D,00001S,00001N,00102S }

    { get the string we want to find }
    s_parm4 := fns_string_eval(27);

    { get the starting point }
    i_parm3 := fni_decimal_eval(20);

    { get the string we want to look in }
    s_parm2 := fns_string_eval(13);

    b_process := true;
    i_long4 := Length(s_parm4);
	i_long2 := Length(s_parm2);

    if (i_parm3 < 1) or (i_long4 = 0) then b_process := false;
    if (i_long4 > i_long2) then b_process := false;

    if b_process then
    begin
		{ ix must be small enough for s_parm2 to hold s_parm4 }
		ix := Succ(i_long2 - i_long4);
        if (ix > i_parm3) then ix := i_parm3;

        b_match := false;
        b_loop := true;

        while b_loop do
        begin
            if (s_parm4[1] = s_parm2[ix]) then
            begin
                b_match := true;

                for iz := 2 to i_long4 do
                begin
                    if (s_parm4[iz] <> s_parm2[Pred(ix + iz)])
                    then b_match := false;
                end;

                if b_match then b_loop := false;
            end;

            if not b_match then
            begin
                Dec(ix);
                if (ix < 1) then b_loop := false;
            end;
        end;
    end
    else ix := 0;


    { store the find answer }
    sub_store_decimal(6, ix);
end; { sub_comm_sbak }


procedure TForm1.sub_comm_sinp(const pbyte_1 : byte);
{ updated 2006/06/11, 2005/03/23, 2004/01/18 }
{ perform the command $INP }
var
    iz : integer;
    sz : string;
begin
    fb_string_input := false;

    if (pbyte_1 = 1) then
    begin
        { 123456789012345678 }
        { $INP 00101S,00201S }

        { get the input location into fi_input }
        fi_input := StrToIntDef(Copy(fs_tpline, 6, 5), -1);
        if (fi_input = -1) then
        begin
            sub_program_error('bad variable link');
        end
        else
        begin
            if (fs_tpline[11] = 'S') then Inc(fi_input, fi_delta_s);

            { output the prompt string }
            sz := fns_string_parse(Copy(fs_tpline, 13, 200));
            sub_memo_show(sz, 1);

            { set the values to drop out and to return to processing }
            fb_program_loop := false;
            fb_string_input := true;
            edit_input.setfocus;
        end;
    end
    else
    begin
        { make sure there are no escape characters in fs_input }
        fs_input := fns_blank_escapes(fs_input);

        { store the user input fs_input in fi_input }
        fsa_var[fi_input] := fs_input;

        { add the user input to the memo_show }
        iz := Length(Trim(fs_input));
        if (iz > 0) then sub_memo_show(fs_input, 1);
    end;

    Application.ProcessMessages;
end; { sub_comm_sinp }


procedure TForm1.sub_comm_sisc;
{ updated 2003/10/28 }
{ is string made up of certain char }
var
	i_result : integer;
    s_parm2, s_parm3 : string;
	i_long2, i_long3 : integer;
    sz : string;
begin
    { 1234567890123456789012345 }
    { $isc 00101n,00099n,00032n }

    { parm2, parm3 }
    s_parm2 := fns_string_eval(13);
    s_parm3 := fns_string_eval(20);
    i_long2 := Length(s_parm2);
    i_long3 := Length(s_parm3);

    i_result := 2;

    if (i_long2 > 0) and (i_long3 > 0) then
    begin
        sz := StringOfChar(s_parm3[1], i_long2);
        if (s_parm2 = sz) then i_result := 1;
    end;

    sub_store_decimal(6, i_result);
end; { sub_comm_sisc }


procedure TForm1.sub_comm_schs;
{ updated 2003/04/26 }
{ to perform the command $CH$ }
var
    s_parm2 : string;
    i_parm3 : integer;
    i_char : integer;
    sz : string;
begin
    { 1234567890123456789012345 }
    { $CH$ 00101n,00099n,00065n }
    s_parm2 := fns_string_eval(13);
    i_parm3 := fni_decimal_eval(20);

    i_char := 32;
    if (Length(s_parm2) = 0) then i_parm3 := 0
    else i_char := Ord(s_parm2[1]);

    if (i_parm3 < 0) then i_parm3 := 0;

    if (i_parm3 > fi_max_length) then
    begin
        sub_program_error('string too long');
    end
    else
    begin
        { make the string }
        sz := StringOfChar(Chr(i_char), i_parm3);
        sub_store_string(6, sz);
    end;
end; { sub_comm_schs }


procedure TForm1.sub_comm_schd;
{ updated 2002/09/05 }
var
    sz : string;
begin
    { 123456789012345678 }
    { $CHD 00401D,00101S }

    sz := fns_string_eval(13);
    if (Length(sz) = 0) then sz := Chr(0);

    sub_store_decimal(6, Ord(sz[1]));
end; { sub_comm_schn }


procedure TForm1.sub_comm_scod;
{ updated 2006/01/17, 2003/12/25 }
{ encode a string }
var
    s_parm2 : string;
    i_char : integer;
    i_long : integer;
    iz : integer;
begin
    { 123456789012345678 }
    { $COD 00101n,00099n }

    s_parm2 := fns_string_eval(13);

    { forty-seven }
    i_long := Length(s_parm2);

    for iz := 1 to i_long do
    begin
        i_char := Ord(s_parm2[iz]);
        if (i_char > 32) and (i_char < 127) then
        begin
            Inc(i_char, 47);
            if (i_char > 126) then Dec(i_char, 94);
            s_parm2[iz] := Chr(i_char);
        end;
    end;

    sub_store_string(6, s_parm2);
end; { sub_comm_scod }


procedure TForm1.sub_comm_stoe;
{ updated 2006/08/24, 2006/04/14 }
{ old toe a string }
var
    s_parm2 : string;
    s_parm3 : string;
    i_bigprime : integer;
    i_number : integer;
    i_char : integer;
    i_long : integer;
    i_slip : integer;
    i_which : integer;
    cz : char;
    iz : integer;
begin
    { 12345678901234567890123456789012 }
    { $TOE 00101n,00099n,00001n,00002n }

    s_parm2 := fns_string_eval(13);
    s_parm3 := fns_string_eval(20);
    i_which := fni_decimal_eval(27);
    if (i_which <> 1) then i_which := 2;

    i_bigprime := 700000001;
    s_parm3 := UpperCase(s_parm3);
    if (Length(s_parm3) > 16) then s_parm3 := Copy(s_parm3, 1, 16);

    { change key to i_number }
    i_number := 0;
    i_long := Length(s_parm3);

    for iz := 1 to i_long do
    begin
        cz := s_parm3[iz];
        i_char := Ord(cz);

        if ((cz >= '0') and (cz <= '9'))
        or ((cz >= 'A') and (cz <= 'Z')) then
        i_number := i_number * 10 + i_char;

        if (i_number > i_bigprime) then i_number := i_number - i_bigprime;
    end;

    { old toe }
    i_long := Length(s_parm2);

    for iz := 1 to i_long do
    begin
        { get the next i_number }
        i_number := (i_number * 3 + 35731) mod i_bigprime;
        i_slip := (i_number div 103) mod 95 + 1;

        i_char := Ord(s_parm2[iz]);
        if (i_char >= 32) and (i_char <= 126) then
        begin
            if (i_which = 1) then i_char := i_char + i_slip
            else i_char := i_char - i_slip;

            if (i_char > 126) then Dec(i_char, 95)
            else if (i_char < 32) then Inc(i_char, 95);

            s_parm2[iz] := Chr(i_char);
        end;
    end;

    sub_store_string(6, s_parm2);
end; { sub_comm_stoe }


procedure TForm1.sub_comm_spar;
{ updated 2002/09/05 }
{ extract a string from a character separated variable }
var
	s_result : string;
    s_parm2, s_parm3 : string;
    i_parm4 : integer;
    char_parm3 : char;
	i_long : integer;
	i_count : integer;
	i_beg, i_end : integer;
	iz : integer;
	b_loop : boolean;
    b_good : boolean;
begin
    { 12345678901234567890123456789012 }
    { spar 00101n,00099n,00032n,00022n }

    { parm2, parm3 and parm4 }
    s_parm2 := fns_string_eval(13);
    s_parm3 := fns_string_eval(20);
    i_parm4 := fni_decimal_eval(27);

    s_result := '';
    b_good := true;

    if (Length(s_parm2) = 0) then b_good := false;
    if (Length(s_parm3) = 0) then b_good := false;

    if b_good then
    begin
        char_parm3 := s_parm3[1];

    	i_long := Length(s_parm2);

        if (s_parm2[i_long] <> char_parm3) then
        begin
            s_parm2 := s_parm2 + char_parm3;
            Inc(i_long);
        end;

        i_beg := 1;
	    i_end := 0;
    	i_count := 0;
        iz := 1;
    	b_loop := true;

        while b_loop do
        begin
	    	if (s_parm2[iz] = char_parm3) then
            begin
    			i_beg := Succ(i_end);
            	i_end := iz;
		    	Inc(i_count);

			    if (i_count = i_parm4) then
                begin
	    			s_result := Copy(s_parm2, i_beg, i_end - i_beg);
	                b_loop := false;
			    end;
    		end;

	    	Inc(iz);
		    if (iz > i_long) then b_loop := false;
        end;
    end;

    sub_store_string(6, s_result);
end; { sub_comm_spar }


procedure TForm1.sub_comm_sdot;
{ updated 2006/05/12, 2003/11/07 }
{ find dot=byte of counted occurrence of string in other string }
var
    s_parm2, s_parm3 : string;
    i_parm4 : integer;
    i_long3, i_long2 : integer;
    i_max : integer;
    i_count : integer;
    i_dot : integer;
    iw, ix, iz : integer;
    b_loop : boolean;
    b_match : boolean;
    b_process : boolean;
begin
    { 12345678901234567890123456789012 }
    { $DOT 00401D,00001S,00001N,00102S }

    { get the string we want to look in }
    s_parm2 := fns_string_eval(13);

    { get the string we want to find }
    s_parm3 := fns_string_eval(20);

    { get the occurrence count of the string }
    i_parm4 := fni_decimal_eval(27);

    b_process := true;
    i_long3 := Length(s_parm3);
	i_long2 := Length(s_parm2);

    if (i_parm4 < 1) or (i_parm4 > i_long2) then b_process := false;
    if (i_long3 = 0) or (i_long3 > i_long2) then b_process := false;

    i_dot := 0;

    if b_process then
    begin
		{ ix is what we are looking for }
		ix := 1;
        { i_max is the maximum that ix can be }
        i_max := Succ(i_long2 - i_long3);
        i_count := 0;
        b_match := false;
        b_loop := true;

        while b_loop do
        begin
            if (s_parm3[1] = s_parm2[ix]) then
            begin
                b_match := true;
                iw := Pred(ix);

                for iz := 2 to i_long3 do
                begin
                    if (s_parm3[iz] <> s_parm2[iw + iz])
                    then b_match := false;
                end;

                if b_match then
                begin
                    Inc(i_count);
                    if (i_count = i_parm4) then
                    begin
                        b_loop := false;
                        i_dot := ix;
                    end;
                    { so that occurrences cannot overlap }
                    ix := ix + Pred(i_long3);
                end;
            end;

            Inc(ix);
            if (ix > i_max) then b_loop := false;
        end;
    end;

    { store the find answer }
    sub_store_decimal(6, i_dot);
end; { sub_comm_sdot }


procedure TForm1.sub_comm_sisp;
{ updated 2004/01/02 }
{ string is pattern of types }
var
	i_result : integer;
    s_parm2, s_parm3 : string;
	i_long : integer;
	i_byte : integer;
	i_char1, i_char2 : integer;
	iz : integer;
	b_loop : boolean;
    b_good : boolean;
begin
    { 1234567890123456789012345 }
    { $ISP 00101n,00099n,00032n }

    { parm2, parm3 and parm4 }
    s_parm2 := fns_string_eval(13);
    s_parm3 := fns_string_eval(20);

    { if i_result = 1 the strings have the same pattern }
    i_result := 2;
    b_good := true;

    i_long := Length(s_parm2);
    if (i_long <> Length(s_parm3)) then b_good := false;
    if (i_long < 1) then b_good := false;

    if b_good then
    begin
        i_result := 1;
        i_byte := 1;
        b_loop := true;

        while b_loop do
        begin
            i_char1 := Ord(s_parm2[i_byte]);
            i_char1 := fni_pattern(i_char1);

            i_char2 := Ord(s_parm3[i_byte]);
            i_char2 := fni_pattern(i_char2);

            if (i_char1 <> i_char2) then
            begin
                i_result := 2;
                b_loop := false;
            end;

            Inc(i_byte);
            if (i_byte > i_long) then b_loop := false;
        end;
    end;

    sub_store_decimal(6, i_result);
end; { sub_comm_sisp }


procedure TForm1.sub_comm_sist;
{ updated 2004/01/02 }
{ string is type of character }
var
	i_result : integer;
    s_parm2, s_parm3 : string;
	i_long : integer;
	i_byte : integer;
	i_char1, i_char2 : integer;
	iz : integer;
	b_loop : boolean;
    b_good : boolean;
begin
    { 1234567890123456789012345 }
    { $ist 00101n,00099n,00032n }

    { parm2, parm3 and parm4 }
    s_parm2 := fns_string_eval(13);
    s_parm3 := fns_string_eval(20);

    { if i_result = 1 the string is the same type }
    i_result := 2;
    b_good := true;

    i_long := Length(s_parm2);
    if (Length(s_parm3) < 1) then b_good := false;
    if (i_long < 1) then b_good := false;

    if b_good then
    begin
        i_char2 := Ord(s_parm3[1]);
        i_char2 := fni_pattern(i_char2);

        i_result := 1;
        i_byte := 1;
        b_loop := true;

        while b_loop do
        begin
            i_char1 := Ord(s_parm2[i_byte]);
            i_char1 := fni_pattern(i_char1);

            if (i_char1 <> i_char2) then
            begin
                i_result := 2;
                b_loop := false;
            end;

            Inc(i_byte);
            if (i_byte > i_long) then b_loop := false;
        end;
    end;

    sub_store_decimal(6, i_result);
end; { sub_comm_sist }


function TForm1.fni_pattern(const pi_char : integer) : integer;
{ updated 2002/11/07 }
var
    i_result : integer;
begin
    Case pi_char of
        0 .. 31 : i_result := 1;
        32      : i_result := 2;
        33 .. 47 : i_result := 3;
        48 .. 57 : i_result := 4;
        58 .. 64 : i_result := 3;
        65 .. 90 : i_result := 5;
        91 .. 96 : i_result := 3;
        97 .. 122 : i_result := 6;
        123 .. 126 : i_result := 3;
    else
        i_result := 7;
    end;

    Result := i_result;
end; { fni_pattern }


procedure TForm1.sub_comm_scut;
{ updated 2004/03/04 }
{ cut part of a string to make another string }
var
    s_parm2 : string;
    i_parm3, i_parm4 : integer;
    s_result : string;
    i_length : integer;
    b_good : boolean;
begin
    { 12345678901234567890123456789012 }
    { $CUT 00101n,00099n,00032n,00005n }

    { parm2, parm3 and parm4 }
    s_parm2 := fns_string_eval(13);
    i_parm3 := fni_decimal_eval(20);
    i_parm4 := fni_decimal_eval(27);

    s_result := '';
    b_good := true;

    i_length := Length(s_parm2);

    if (i_length < 1) or (i_parm4 < 1) or (i_parm3 > i_length)
    then b_good := false;

    if (i_parm3 < 1) then i_parm3 := 1;

    if b_good then s_result := Copy(s_parm2, i_parm3, i_parm4);

    sub_store_string(6, s_result);
end; { sub_comm_scut }


procedure TForm1.sub_comm_soff;
{ updated 2003/05/27 }
{ cut off end of a string by length to make another string }
var
    i_beg : integer;
    i_length : integer;
    s_parm2 : string;
    i_parm3, i_parm4 : integer;
begin
    { 1234567890123456789012345 }
    { $OFF 00101n,00099n,00032n }

    { parm2 and parm3 }
    s_parm2 := fns_string_eval(13);
    i_parm3 := fni_decimal_eval(20);
    i_beg := Length(s_parm2) - i_parm3 + 1;
    if (i_beg < 1) then i_beg := 1;
    i_length := Length(s_parm2) - i_beg + 1;

    sub_store_string(6, Copy(s_parm2, i_beg, i_length));
end; { sub_comm_soff }


procedure TForm1.sub_comm_evar;
{ updated 2007/06/16, 2004/01/24 }
{ initialize variables, this line happens after last VARI command }
var
    i_var_ct : integer;
begin
    { 123456789012345678 }
    { EVAR,00000N,00000N }
    { decimals }
    { i_var_ct is how many local decimals are in this subroutine }
    i_var_ct := StrToIntDef(Copy(fs_tpline, 6, 5), 0);

    { fi_delta_d is how many decimals there are before this subroutine }
    fi_delta_d := fia_delta_d[fii_delta_d];

    Inc(fii_delta_d);
    Inc(i_var_ct, fi_delta_d);
    if (i_var_ct > fi_max_delta_d) then fi_max_delta_d := i_var_ct;

    if (i_var_ct > fi_max_dvar) or (fii_delta_d > 1000) then
        sub_program_error('too many decimals')
    else fia_delta_d[fii_delta_d] := i_var_ct;
    { fii_delta_d is the index for fia_delta_d }

    { strings }
    { i_var_ct is how many local strings are in this subroutine }
    i_var_ct := StrToIntDef(Copy(fs_tpline, 13, 5), 0);

    { fi_delta_s is how many strings there are before this subroutine }
    fi_delta_s := fia_delta_s[fii_delta_s];

    Inc(fii_delta_s);
    Inc(i_var_ct, fi_delta_s);
    if (i_var_ct > fi_max_delta_s) then fi_max_delta_s := i_var_ct;

    if (i_var_ct > fi_max_svar) or (fii_delta_s > 1000) then
        sub_program_error('too many strings')
    else fia_delta_s[fii_delta_s] := i_var_ct;
    { fii_delta_s is the index for fia_delta_s }
end; { sub_comm_evar }


procedure TForm1.sub_comm_ends;
{ updated 2000/01/01 }
var
    i_beg, i_end : integer;
    iz : integer;
begin
    { decimals }
    { fi_delta_d is how many decimals there are before this subroutine }
    i_beg := Succ(fi_delta_d);
    i_end := fia_delta_d[fii_delta_d];

    { zero the places where the variables were }
    for iz := i_beg to i_end do fea_var[iz] := 0;

    Dec(fii_delta_d);
    fi_delta_d := fia_delta_d[Pred(fii_delta_d)];

    { strings }
    { fi_delta_s is how many strings there are before this subroutine }
    i_beg := Succ(fi_delta_s);
    i_end := fia_delta_s[fii_delta_s];

    { set to nothing the strings where the variables were }
    for iz := i_beg to i_end do fsa_var[iz] := '';

    Dec(fii_delta_s);
    fi_delta_s := fia_delta_s[Pred(fii_delta_s)];

    { pop from the stack where we return to }
    fi_tpline := fia_sub[fii_sub];
    Dec(fii_sub);
end; { sub_comm_ends }


procedure TForm1.sub_comm_ssys;
{ updated 2003/12/15 }
{ get various string program information }
var
    i_parm2 : integer;
    s_info : string;
begin
    { 123456789012345678 }
    { $SYS,00000N,00000N }
    i_parm2 := fni_decimal_eval(13);
    s_info := 'none';

    { application name and path }
    if (i_parm2 = 1) then s_info := LowerCase(Application.ExeName);

    { current program subroutine }
    if (i_parm2 = 2) then s_info := fns_subroutine(fi_tpline);

    sub_store_string(6, s_info);
end; { sub_comm_ssys }


procedure TForm1.sub_comm_dsys;
{ updated 2007/06/16, 2006/04/30, 2004/06/19 }
{ get various numeric program information }
var
    i_parm2 : integer;
    d_info : double;
    d_total : double;
    i_long : integer;
    iz : integer;
begin
    { 123456789012345678 }
    { $SYS,00000N,00000N }
    i_parm2 := fni_decimal_eval(13);
    d_info := 0;

    { memory used by strings }
    if (i_parm2 = 1) then
    begin
        d_total := 0;

        { total string variables }
        for iz := 1 to fi_max_svar do
        begin
            d_total := d_total + Length(fsa_var[iz]);
        end;

        { total string array }
        for iz := 1 to fi_max_sarray do
        begin
            d_total := d_total + Length(fsa_array[iz]);
        end;

        { total run program and actual program strings }
        for iz := 1 to 15000 do
        begin
            d_total := d_total + Length(fsa_tpline[iz]);
        end;

        d_info := d_total;
    end;

    { total lines run }
    if (i_parm2 = 2) then d_info := fd_total_lines;

    sub_store_decimal(6, d_info);
end; { sub_comm_dsys }


function TForm1.fns_subroutine(const pi_line : integer) : string;
{ updated 2003/12/15 }
var
    s_result : string;
    sz : string;
    i_line : integer;
    iz : integer;
    b_loop : boolean;
begin
    s_result := 'none';
    i_line := pi_line;
    b_loop := true;
    if (i_line < 1) or (i_line > fi_tpline_last) then b_loop := false;

    while b_loop do
    begin
        sz := Copy(fsa_tpline[i_line], 1, 4);

        if (sz = 'SUBR') then
        begin
            s_result := LowerCase(Copy(fsa_tpline[i_line], 6, 99));
            iz := Pos(';', s_result);
            if (iz > 0) then s_result := Copy(s_result, 1, Pred(iz));
            b_loop := false;
        end;

        Dec(i_line);
        if (i_line < 1) then b_loop := false;
    end;
    Result := s_result;
end; { fns_subroutine }


procedure TForm1.sub_comm_file(const pbyte_1 : byte);
{ updated 2006/06/02, 2006/05/23, 2004/04/08 }
{ put length of file in bytes in variable }
var
    file_1 : file;
    i_parm2 : integer;
    s_filename1, s_filename2 : string;
    i_long : integer;
    ez : double;
    sz : string;
    iz : integer;
    bz : boolean;
begin
    if (pbyte_1 = 1) then { FDAT }
    begin
        { 1234567890123456789012345 }
        { FDAT 00401n,00402n,00101n }
        i_parm2 := StrToIntDef(Copy(fs_tpline, 13, 5), -1);
        if (i_parm2 = -1) then
        begin
            sub_program_error('bad variable link');
        end
        else
        begin
            s_filename1 := fns_string_eval(20);

            { both parm1 and parm2 must receive values }
            if (fs_tpline[18] = 'S') then Inc(i_parm2, fi_delta_s);
            if (fs_tpline[11] = 'D') then Inc(fi_link, fi_delta_d);

            ez := 0;
            sz := '';

            if FileExists(s_filename1) then
            begin
                ez := FileDateToDateTime(FileAge(s_filename1));
                sz := UpperCase(FormatDateTime('dd-mmm-yyyy hh:nn:ss', ez));
            end;

            fea_var[fi_link] := ez;
            fsa_var[i_parm2] := sz;
        end;
    end
    else if (pbyte_1 = 2) then { FDEL }
    begin
        { 123456789012345678 }
        { FDEL 00001n,00101n }
        s_filename1 := fns_string_eval(13);
        s_filename1 := Trim(s_filename1);
        iz := Pos('*', s_filename1);
        if (iz = 0) then iz := Pos('?', s_filename1);

        { get the name and delete the file }
        bz := false;
        if (iz = 0) then bz := DeleteFile(s_filename1);
        if bz then iz := 1 else iz := 2;

        { save the results of fdel }
        sub_store_decimal(6, iz);
    end
    else if (pbyte_1 = 3) then { FLEN }
    begin
        { 123456789012345678 }
        { FLEN 00901p,00101n }
        s_filename1 := fns_string_eval(13);
        i_long := -1;

        if FileExists(s_filename1) then
        begin
            AssignFile(file_1, s_filename1);

            {$I-}
            Reset(file_1, 1);

            { get the length of the file in bytes }
            i_long := FileSize(file_1);

            CloseFile(file_1);
            {$I+}

            if (IOResult <> 0) then i_long := -1;
        end;

        { save the length of the file in bytes }
        sub_store_decimal(6, i_long);
    end
    else if (pbyte_1 = 4) then { FREN }
    begin
        { rename the file s_filename2 to s_filename1 }
        { 1234567890123456789012345 }
        { FREN 00001n,00101n,00102n }
        s_filename1 := fns_string_eval(13);
        s_filename2 := fns_string_eval(20);
        s_filename1 := LowerCase(s_filename1);
        bz := RenameFile(s_filename2, s_filename1);
        if bz then iz := 1 else iz := 2;

        { save the results of fren }
        sub_store_decimal(6, iz);
    end;
end; { sub_comm_file }


procedure TForm1.sub_comm_frea;
{ updated 2003/09/15 }
{ record input from file fs_filename_1 }
var
    file_1 : file;
    chara_4096 : array[1..4096] of char;
    i_bytes_read : integer;
    i_byte : integer;
    i_long : integer;
    s_filename : string;
    s_record : string;
    iz : integer;
begin
    { 12345678901234567890123456789012 }
    { FREA 00901p,00101n,00902p,00072n }
    { FREA 00101n,00401p,00402p,00102n }
    { FREA s_rec1,s_filename1,nbyte1,nlong1 }
    s_filename := fns_string_eval(13);
    i_byte := fni_decimal_eval(20);
    i_long := fni_decimal_eval(27);
    s_record := '';

    { in Teapro the first byte 1 in Delphi it is 0 }
    { set FileMode to zero to make sure the file is read only }
    if FileExists(s_filename) then
    begin
        AssignFile(file_1, s_filename);

        {$I-}
        FileMode := 0;
        Reset(file_1, 1);
        Seek(file_1, Pred(i_byte));
        BlockRead(file_1, chara_4096, i_long, i_bytes_read);
        CloseFile(file_1);
        {$I+}

        { if no IO error }
        if (IOResult = 0) then
        begin
            if (i_bytes_read < i_long) then i_long := i_bytes_read;
            s_record := StringOfChar(' ', i_long);

            for iz := 1 to i_long do s_record[iz] := chara_4096[iz];
        end;
    end;

    sub_store_string(6, s_record);
end; { sub_comm_frea }


procedure TForm1.sub_comm_fwri;
{ updated 2003/09/15 }
{ record out to file file_1 }
var
    file_1 : file;
    chara_4096 : array[1..4096] of char;
    i_file_length : integer;
    i_bytes_written : integer;
    i_byte : integer;
    s_record : string;
    s_filename : string;
    iz : integer;
    b_exists : boolean;
begin
    { 1234567890123456789012345 }
    { FWRI 00401p,00101n,00102n }
    s_filename := fns_string_eval(13);
    i_byte := fni_decimal_eval(20);
    s_record := fns_string_eval(27);
{
showmessage('file=' + s_filename + '@');
showmessage(inttostr(i_byte) + ' @' + s_record + '@');
showmessage('record length=' + inttostr(length(s_record)));
}
    { in Teapro the first byte is 1 in Delphi it is 0 }
    i_bytes_written := 0;

    for iz := 1 to Length(s_record) do
        chara_4096[iz] := s_record[iz];

    s_filename := LowerCase(s_filename);
    b_exists := FileExists(s_filename);

    { set FileMode to 1 for write only }
    AssignFile(file_1, s_filename);

    {$I-}
    FileMode := 1;
    if b_exists then Reset(file_1, 1)
    else Rewrite(file_1, 1);

    { we cannot write beyond the length + 1 }
    i_file_length := FileSize(file_1);
    if (i_byte > Succ(i_file_length)) then i_byte := Succ(i_file_length);

    Seek(file_1, Pred(i_byte));
    BlockWrite(file_1, chara_4096, Length(s_record), i_bytes_written);
    CloseFile(file_1);
    {$I+}

    { faux line to get rid of IOResult }
    if (IOResult <> 0) then iz := 0;

    { save the length written }
    sub_store_decimal(6, i_bytes_written);
end; { sub_comm_fwri }


procedure TForm1.sub_comm_finp;
{ updated 2003/09/15 }
{ entire file input }
var
    file_1 : file;
    chara_4096 : array[1..4096] of char;
    i_bytes_read : integer;
    i_file_byte : integer;
    i_file_length : integer;
    s_filename : string;
    s_data : string;
    iz : integer;
    b_loop : boolean;
    b_open : boolean;
    b_good : boolean;
begin
    { 123456789012345678 }
    { FINP 00901p,00101n }
    s_filename := fns_string_eval(13);
    s_data := '';

    b_open := false;
    b_good := FileExists(s_filename);

    if b_good then
    begin
        { open the file as an existing file }
        { set FileMode to zero to make sure the file is read only }
        AssignFile(file_1, s_filename);

        {$I-}
        FileMode := 0;
        Reset(file_1, 1);
        {$I+}

        if (IOResult = 0) then b_open := true
        else b_good := false;
    end;

    if b_good then
    begin
        { get the length of the file }
        {$I-}
        i_file_length := FileSize(file_1);
        {$I+}

        if (IOResult <> 0) then b_good := false;
    end;

    if b_good then
    begin
        if (i_file_length > fi_max_length) then
        begin
            b_good := false;
            sub_program_error('file too big');
        end;
    end;

    if b_good then
    begin
        s_data := StringOfChar(' ', i_file_length);

        { read the entire file into string sdata }
        i_file_byte := 0;
        b_loop := true;

        while b_loop do
        begin
            { finp }
            Application.ProcessMessages;

            {$I-}
            Seek(file_1, i_file_byte);
            BlockRead(file_1, chara_4096, 4096, i_bytes_read);
            {$I+}

            if (IOResult <> 0) then
            begin
                b_loop := false;
                b_good := false;
            end;

            for iz := 1 to i_bytes_read do
                s_data[i_file_byte + iz] := chara_4096[iz];

            Inc(i_file_byte, i_bytes_read);
            if (Succ(i_file_byte) >= i_file_length) then b_loop := false;
        end;
    end;

    { close the file if needed }
    if b_open then CloseFile(file_1);

    if not b_good then s_data := '';

    sub_store_string(6, s_data);
end; { sub_comm_finp }


procedure TForm1.sub_comm_fout;
{ updated 2003/09/15 }
{ entire file output }
var
    file_1 : file;
    chara_4096 : array[1..4096] of char;
    i_bytes_written : integer;
    i_tbytes_written : integer;
    i_string_byte : integer;
    s_string : string;
    s_record : string;
    i_long : integer;
    s_filename : string;
    iz : integer;
    b_loop : boolean;
    b_open : boolean;
    b_good : boolean;
begin
    { 1234567890123456789012345 }
    { FOUT 00401p,00101n,00102n }
    s_filename := fns_string_eval(13);
    s_string := fns_string_eval(20);

    s_filename := LowerCase(s_filename);
    i_long := Length(s_string);

    i_tbytes_written := 0;
    b_good := true;
    b_open := false;

    if b_good then
    begin
        AssignFile(file_1, s_filename);

        { open the file for write only }
        {$I-}
        FileMode := 1;
        Rewrite(file_1, 1);
        {$I+}

        if (IOResult = 0) then b_open := true
        else b_good := false;
    end;

    if b_good then
    begin
        i_string_byte := 1;
        b_loop := true;

        while b_loop do
        begin
            s_record := Copy(s_string, i_string_byte, 4096);
            for iz := 1 to Length(s_record) do
                chara_4096[iz] := s_record[iz];

            {$I-}
            Seek(file_1, Pred(i_string_byte));
            BlockWrite(file_1, chara_4096, Length(s_record), i_bytes_written);
            {$I+}

            if (IOResult <> 0) then
            begin
                b_loop := false;
                b_good := false;
            end;

            { fout }
            Application.ProcessMessages;

            Inc(i_tbytes_written, i_bytes_written);

            Inc(i_string_byte, i_bytes_written);

            if (i_string_byte > i_long) then b_loop := false;
        end;
    end;

    if b_open then CloseFile(file_1);

    { save the length written }
    sub_store_decimal(6, i_tbytes_written);
end; { sub_comm_fout }


procedure TForm1.sub_comm_fsip;
{ updated 2005/04/16, 2003/09/15 }
{ read line from file fs_filename_1 }
var
    file_1 : file;
    chara_4096 : array[1..4096] of char;
    s_char10 : string;
    s_char13 : string;
    i_bytes_read : integer;
    i_oldbyte : integer;
    i_newbyte : integer;
    i_long : integer;
    i_error : integer;
    s_filename : string;
    i_filelength : integer;
    s_record : string;
    b_good : boolean;
    sz : string;
    iz : integer;
begin
    { 1234567890123456789012345 }
    { FSIP 00901p,00101n,00902p }
    { FSIP s_reco,s_filename,d_byte }
    s_filename := fns_string_eval(13);
    i_oldbyte := fni_decimal_eval(20);

    { initialize }
    s_char10 := Chr(10);
    s_char13 := Chr(13);
    i_newbyte := 0;
    s_record := '';
    i_bytes_read := 0;

    if FileExists(s_filename) then b_good := true
    else b_good := false;

    if (i_oldbyte < 1) then b_good := false;

    { in Teapro the first byte 1 in Delphi it is 0 }
    { set FileMode to zero to make sure the file is read only }
    if b_good then
    begin
        AssignFile(file_1, s_filename);

        {$I-}
        FileMode := 0;
        Reset(file_1, 1);
        i_filelength := FileSize(file_1);

        if (i_oldbyte > i_filelength) then b_good := false;

        if b_good then
        begin
            { file begin at 0 in Delphi and at 1 in Teapro }
            Seek(file_1, Pred(i_oldbyte));
            BlockRead(file_1, chara_4096, 4096, i_bytes_read);
        end;

        CloseFile(file_1);
        {$I+}

        i_error := IOResult;
        if (i_error > 0) then b_good := false;

        if b_good then
        begin
            s_record := chara_4096;
            s_record := Copy(s_record, 1, i_bytes_read);
            i_newbyte := i_oldbyte + i_bytes_read;

            { look for a s_char10 = line feed }
            i_long := Pos(s_char10, s_record);

            if (i_long > 0) then
            begin
                { s_char10 in i_long is s_char13 in i_long - 1 }
                iz := i_long - 1;
                sz := Copy(s_record, iz, 1);
                if (sz = s_char13) then Dec(iz);

                s_record := Copy(s_record, 1, iz);
                i_newbyte := i_oldbyte + i_long;
            end;
        end;
    end;

    { if no record was read }
    if not b_good then i_newbyte := 0;

    { put the new position into the third parameter variable }
    iz := StrToIntDef(Copy(fs_tpline, 20, 5), -1);
    if (iz = -1) then
    begin
        sub_program_error('bad variable link');
    end
    else
    begin
        sub_store_decimal(20, i_newbyte);

        { put the string into the first parameter variable }
        sub_store_string(6, s_record);
    end;
end; { sub_comm_fsip }


procedure TForm1.sub_comm_fapp(const pbyte_1 : byte);
{ updated 2005/09/07, 2005/06/20, 2005/04/18, 2003/09/16 }
{ append line to file with lf or crlf added to end }
{ pbyte_1=1 means FAPP crlf }
{ pbyte_1=2 means FADD lf }
var
    file_1 : file;
    chara_4096 : array[1..4098] of char;
    i_file_length : integer;
    i_bytes_written : integer;
    i_byte : integer;
    s_record : string;
    s_filename : string;
    i_count : integer;
    iz : integer;
    b_loop : boolean;
    b_error : boolean;
    b_exists : boolean;
begin
    { 1234567890123456789012345 }
    { FAPP 00401p,00101n,00101n }
    { FADD 00401p,00101n,00101n }
    s_filename := fns_string_eval(13);
    s_record := fns_string_eval(20);

    { in Teapro the first file byte is 1 in Delphi it is 0 }
    i_bytes_written := 0;

    b_error := false;

    if (Length(s_record) > 4096) then b_error := true;
    if (pbyte_1 = 1) then
    begin
        s_record := s_record + Chr(13) + Chr(10);
    end
    else
    begin
        s_record := s_record + Chr(10);
    end;

    i_count := 0;
    b_loop := true;
    if b_error then b_loop := false;

    while b_loop do
    begin
        { chara_4096 is actually 4098 long }
        for iz := 1 to Length(s_record) do
            chara_4096[iz] := s_record[iz];

        s_filename := LowerCase(s_filename);
        b_exists := FileExists(s_filename);

        { set FileMode to 1 for write only }
        AssignFile(file_1, s_filename);

        {$I-}
        FileMode := 1;
        if b_exists then Reset(file_1, 1)
        else Rewrite(file_1, 1);

        i_file_length := FileSize(file_1);
        i_byte := Succ(i_file_length);

        Seek(file_1, Pred(i_byte));
        BlockWrite(file_1, chara_4096, Length(s_record), i_bytes_written);
        CloseFile(file_1);
        {$I+}

        if (IOResult > 0) then
        begin
            { the record was not appended }
            i_bytes_written := 0;

            Inc(i_count);
            if (i_count >= 10) then b_loop := false
            { FAPP or FADD }
            else for iz := 0 to 1000 do Application.ProcessMessages;
        end
        { the record was appended so we are done }
        else b_loop := false;
    end;

    { save the length written }
    if not b_error then sub_store_decimal(6, i_bytes_written)
    else sub_program_error('string > 4096');
end; { sub_comm_fapp }


function TForm1.fnd_decimal_eval(const pbyte_1 : byte) : double;
{ updated 2002/04/19 }
{ evaluate a number to a decimal }
var
    i_value : integer;
    c_z : char;
begin
    { C = single character }
    { D = local decimal }
    { G = global decimal }
    { N = literal number }
    { R = global string }
    { S = local string }
    i_value := StrToIntDef(Copy(fs_tpline, pbyte_1, 5), -1);

    if (i_value = -1) then
    begin
        sub_program_error('bad integer');
        Result := 0;
    end
    else
    begin
        c_z := fs_tpline[pbyte_1 + 5];

        Case c_z of
            { local variable }
            'D' : Result := fea_var[i_value + fi_delta_d];
            { global variable }
            'G' : Result := fea_var[i_value];
        else
            { literal value }
            Result := i_value;
        end;
    end;
end; { fnd_decimal_eval }


function TForm1.fni_decimal_eval(const pbyte_1 : byte) : integer;
{ updated 2004/03/03 }
{ evaluate a number to a decimal }
var
    dz : double;
    i_value : integer;
    c_z : char;
    i_result : integer;
begin
    { C = single character }
    { D = local decimal }
    { G = global decimal }
    { N = literal number }
    { R = global string }
    { S = local string }

    i_value := StrToIntDef(Copy(fs_tpline, pbyte_1, 5), -1);
    i_result := 0;

    if (i_value = -1) then
    begin
        sub_program_error('bad integer');
    end
    else
    begin
        c_z := fs_tpline[pbyte_1 + 5];

        Case c_z of
            { local variable }
            'D' : dz := fea_var[i_value + fi_delta_d];

            { global variable }
            'G' : dz := fea_var[i_value];
        else
            { literal value }
            dz := i_value;
        end;

        if (dz > MaxInt) then dz := MaxInt
        else if (dz < -MaxInt) then dz := -MaxInt;

        i_result := Round(dz);
    end;

    Result := i_result;
end; { fni_decimal_eval }


function TForm1.fnd_modulus(
    const dp_number : double;
    const dp_divisor : double) : double;
{ updated 2007/01/20, 2007/01/19 }
var
   c_1 : comp;
   c_2 : comp;
   d_result : double;
begin
    { the sign of e_answer prevails }
    c_1 := dp_number;
    c_2 := Abs(dp_divisor);
    d_result := 1;

    if (c_2 > 0) then
    begin
        { find mod }
        d_result := c_1 - Int(c_1 / c_2) * c_2;
    end
    else sub_program_error('zero modulus');

    Result := d_result;
end; { fnd_modulus }


function TForm1.fns_from_double(
    const pd_num : double;
    const pbyte_commas : byte) : string;
{ updated 2004/03/03 }
var
    s_number : string;
    iz : integer;
begin
    { pi2 is 1 to put in commas }
    if (pbyte_commas = 1) then
        s_number := FloatToStrF(pd_num, ffNumber, 16, 16)
    else s_number := FloatToStrF(pd_num, ffFixed, 16, 16);

    s_number := Trim(s_number);

    { not exponential and with decimal }
    if (Pos('E', s_number) = 0) and (Pos('.', s_number) > 0) then
    begin
        iz := Length(s_number);
        while (s_number[iz] = '0') do Dec(iz);
        s_number := Copy(s_number, 1, iz);

        { take off a trailing decimal }
        iz := Length(s_number);
        if (s_number[iz] = '.') then s_number := Copy(s_number, 1, Pred(iz));
    end;

    Result := s_number;
end; { fns_from_double }


procedure TForm1.sub_double_from_string(
    const ps1 : string;
    var pe2 : double;
    var pb3 : boolean);
{ updated 2004/09/25 }
{ convert a string to a double number }
var
    s_digits : string;
    s_number : string;
    e_number : double;
    s_test : string;
    i_dot : integer;
    b_loop : boolean;
    b_negative : boolean;
    b_enumber : boolean;
    sz : string;
    iy, iz : integer;
    b_error : boolean;
begin
    e_number := 0;
    b_error := false;
    b_negative := false;
    s_digits := '0123456789';

    s_number := UpperCase(Trim(ps1));
    if (Length(s_number) = 0) then b_error := true;

    if not b_error then
    begin
        if (s_number[1] = '+') then s_number := Copy(s_number, 2, 999)
        else if (s_number[1] = '-') then
        begin
            s_number := Copy(s_number, 2, 999);
            b_negative := true;
        end;
    end;

    if (Length(s_number) = 0) then b_error := true;
    if not b_error then
    begin
        if (Pos(s_number[1], '+-') > 0) then b_error := true;
    end;

    if not b_error then
    begin
        { take out any commas ie. ,000}
        b_loop := true;
        while b_loop do
        begin
            iz := Pos(',', s_number);
            if (iz = 0) then b_loop := false
            else
            begin
                if (iz = 1) then b_error := true;

                sz := Copy(s_number, Succ(iz), 3);
                iy := StrToIntDef(sz, -1);

                if (iy >= 0) then Delete(s_number, iz, 1)
                else
                begin
                    b_error := true;
                    b_loop := false;
                end;
            end;
        end;

        if (Length(s_number) = 0) then b_error := true;
    end;

    if not b_error then
    begin
        s_test := s_number;

        { validate the E part if any }
        iz := Pos('E', s_test);

        if (iz > 0) then
        begin
            if (iz < 4) or (Length(s_test) - iz < 1) then b_error := true;

            if not b_error then
            begin
                { sz is part following the E }
                sz := Copy(s_test, Succ(iz), 99);
                { s_test is part preceding the E }
                s_test := Copy(s_test, 1, Pred(iz));

                { sz is part following the E }
                if (sz[1] = '-') then sz := Copy(sz, 2, 99);
                iz := StrToIntDef(sz, -1);
                if (iz = -1) then b_error := true;
                if (iz > 4392) then b_error := true;

                { s_test is part preceding the E }
                if (s_test[2] <> '.') then b_error := true;
                if (Pos(s_test[1], s_digits) = 0) then b_error := true;
                if (Pos(s_test[3], s_digits) = 0) then b_error := true;
                { s_test will be further validated below }
            end;
        end;
    end;

    if not b_error then
    begin
        { take off unneccessary leading zeros }
        b_loop := true;
        while b_loop do
        begin
            if (Length(s_test) > 15) and (s_test[1] = '0')
            then s_test := Copy(s_test, 2, 99)
            else b_loop := false;
        end;

        { take off unneccessary trailing zeros }
        i_dot := Pos('.', s_test);
        if (i_dot > 0) then b_loop := true
        else b_loop := false;

        while b_loop do
        begin
            iz := Length(s_test);
            if (iz > 15) and (s_test[iz] = '0')
            then s_test := Copy(s_test, 1, Pred(iz))
            else b_loop := false;
        end;

        { take out the dot }
        i_dot := Pos('.', s_test);
        if (i_dot > 0) then Delete(s_test, i_dot, 1);

        { do we have all numbers }
        for iz := 1 to Length(s_test) do
        begin
            if (Pos(s_test[iz], s_digits) = 0)
            then b_error := true;
        end;

        if (Length(s_test) > 16) then b_error := true;
    end;

    if not b_error then e_number := StrToFloat(s_number);
    if b_negative then e_number := - e_number;

    pe2 := e_number;
    pb3 := b_error;
end; { sub_double_from_string }


procedure TForm1.sub_store_decimal(const pbyte_1 : byte; const pd_1 : double);
{ updated 2002/09/04 }
var
    i_store : integer;
    sz : string;
begin
    { 12345S }
    i_store := StrToIntDef(Copy(fs_tpline, pbyte_1, 5), -1);

    if (i_store < 0) then
    begin
        sub_program_error('bad integer=' + Copy(fs_tpline, pbyte_1, 5));
    end
    else
    begin
        { store the decimal }
        if (fs_tpline[pbyte_1 + 5] = 'D') then Inc(i_store, fi_delta_d);
        fea_var[i_store] := pd_1;
    end;
end; { sub_store_decimal }


procedure TForm1.sub_store_string(const pbyte_1 : byte; const ps_1 : string);
{ updated 2002/09/03 }
var
    i_store : integer;
    sz : string;
begin
    { 12345S }
    i_store := StrToIntDef(Copy(fs_tpline, pbyte_1, 5), -1);

    if (i_store < 0) then
    begin
        sub_program_error('bad integer=' + Copy(fs_tpline, pbyte_1, 5));
    end
    else
    begin
        { store the string }
        if (fs_tpline[pbyte_1 + 5] = 'S') then Inc(i_store, fi_delta_s);
        fsa_var[i_store] := ps_1;
    end;
end; { sub_store_string }


function TForm1.fns_string_eval(const pbyte_1 : byte) : string;
{ updated 2002/04/19 }
var
    i_value : integer;
    c_z : char;
begin
    { C = single character }
    { D = local decimal }
    { G = global decimal }
    { N = literal number }
    { R = global string }
    { S = local string }

    { 123456 }
    { 00101S }

    i_value := StrToIntDef(Copy(fs_tpline, pbyte_1, 5), -1);

    if (i_value = -1) then
    begin
        sub_program_error('bad integer');
        Result := '';
    end
    else
    begin
        c_z := fs_tpline[pbyte_1 + 5];

        Case c_z of

            { single character }
            'C' : Result := Chr(i_value);

            { local decimal variable }
            'D' : Result := fns_from_double(fea_var[i_value + fi_delta_d], 0);

            { global decimal variable }
            'G' : Result := fns_from_double(fea_var[i_value], 0);

            { global or constant string }
            'R' : Result := fsa_var[i_value];

            { local string variable }
            'S' : Result := fsa_var[i_value + fi_delta_s];
        else

            { number = N }
            Result := fns_from_double(i_value, 0);
        end;
    end;
end; { fns_string_eval }


function TForm1.fns_string_parse(const ps1 : string) : string;
{ updated 2003/04/25 }
var
    i_long1, i_long2 : integer;
    s_result : string;
    i_value : integer;
    s_term : string;
    s_line : string;
    b_loop : boolean;
    b_error : boolean;
begin
    { C = single character }
    { D = local decimal }
    { G = global decimal }
    { N = literal number }
    { R = global string }
    { S = local string }

    { 123456 }
    { 00101n }

    { hundred million }
    b_error := false;
    s_line := ps1;
    s_result := '';
    b_loop := false;
    if (Length(s_line) > 5) then b_loop := true;

    while b_loop do
    begin
        i_value := StrToIntDef(Copy(s_line, 1, 5), -1);
        if (i_value = -1) then
        begin
            sub_program_error('bad variable link');
            b_loop := false;
            s_result := '';
        end
        else
        begin
            { local string variable }
            if (s_line[6] = 'S') then s_term := fsa_var[i_value + fi_delta_s]

            { global string variable }
            else if (s_line[6] = 'R') then s_term := fsa_var[i_value]

            { single character }
            else if (s_line[6] = 'C') then s_term := Chr(i_value)

            { local decimal variable }
            else if (s_line[6] = 'D') then s_term :=
                fns_from_double(fea_var[i_value + fi_delta_d], 0)

            { global decimal variable }
            else if (s_line[6] = 'G') then s_term :=
                fns_from_double(fea_var[i_value], 0)

            { number }
            else s_term := fns_from_double(i_value, 0);

            i_long1 := Length(s_result);
            i_long2 := Length(s_term);
            if (i_long1 + i_long2 > fi_max_length) then b_error := true;

            if b_error then
            begin
                b_loop := false;
                sub_program_error('string too long');
            end
            else
            begin
                s_result := s_result + s_term;
                s_line := Copy(s_line, 8, 200);
                if (Length(s_line) < 6) then b_loop := false;
            end;
        end;
    end;

    Result := s_result;
end; { fns_string_parse }


procedure TForm1.sub_memo_show(
    const ps1 : string;
    const pbyte_2 : byte);
{ updated 2005/02/07, 2004/03/04 }
var
    s_line : string;
	i_top : integer;
    iy, iz : integer;
    sz : string;
begin
    s_line := TrimRight(Copy(ps1, 1, 77));

    { blank escape characters }
    s_line := fns_blank_escapes(s_line);

    if not fb_show then
    begin
        { $out rather than $sho }
        { fsa_show is 1..35 }
        for iz := 1 to 34 do fsa_show[iz] := fsa_show[Succ(iz)];
    end;

    { store new output line on the show stack }
    fsa_show[35] := s_line;

    { prep string to show fi_show_lines }
	i_top := 35 - fi_show_lines + 1;
    sz := fsa_show[i_top];

    for iz := 1 to Pred(fi_show_lines) do
        sz := sz + nl + fsa_show[i_top + iz];

    { show on form }
    label_show.caption := sz;

    { pbyte_2=1 comes from $out, pbyte_2=2 from $sho }
    if (pbyte_2 = 1) then fb_show := false
    else fb_show := true;
end; { sub_memo_show }


function TForm1.fns_blank_escapes(const ps1 : string) : string;
{ updated 2004/01/18 }
{ replace escape characters with blanks/nothing }
var
    s_result : string;
    iz : integer;
begin
    s_result := ps1;

    for iz := 1 to Length(s_result) do
    begin
        if (s_result[iz] < ' ') then s_result[iz] := ' ';
    end;

    Result := s_result;
end; { fns_blank_escapes }


procedure TForm1.sub_commands_to_int;
{ updated 2007/04/14 }
{ 2007/01/19, 2006/06/02, 2006/05/12, 2005/03/22, 2004/10/19 }
var
    i_command : integer;
    i_line : integer;
    s_commands : string;
    s_comm : string;
    i_index : integer;
    sz : string;
begin
    { this is the command list for real }
    s_commands := ''
        + 'DABS,DARC,DCH$,DDEC,DED$,DFAC,DIF1,'
        + 'DIFT,DINC,DLOG,DPK$,DPOW,DRAN,DROU,'
        + 'DSEC,DSET,DSIN,DTO$,DTOF,DTOI,DTRU,DWHI,'

        + 'ELSE,ENDI,ENDP,ENDS,ENDW,ESUB,XXXX,EVAR,'
        + 'ITO$,ITOD,'

        + '$APP,$BAK,$BES,$CH$,$CHD,$CLO,$CNT,$COD,$CUP,'
        + '$CUT,$DAT,$DEL,$DOT,$IF1,$IFT,$INP,$INS,$ISC,'
        + '$ISD,$ISP,$IST,$LEN,$LOK,$OFF,$OUT,$PAR,$PKD,'
        + '$REP,$SET,$SHO,$SOR,$SWP,$SYS,$TLO,$TOD,$TOI,'
        + '$TRB,$TRL,$TRR,$TUP,$WHI,'

        + 'FDAT,FDEL,FLEN,FREN,'
        + 'FINP,FOUT,'
        + 'FSIP,FAPP,FADD,'
        + 'FREA,FWRI,'

        + 'QAPP,QINP,QOUT,QSET,QTOI,'
        + 'XXXX,XXXX,XXXX,XXXX,XXXX,'
        + 'ARRZ,ARRB,ADDI,DSYS,DBAD,'
        + '$TOE,$HSH,DBUG,DFAK,GOTO,'
        + 'GTAG,SUBR,VARI';

    fi_tpline := 0;
    i_line := 1;

    while (i_line <= fi_tpline_last) and not fb_terminate do
    begin
        fs_tpline := fsa_tpline[i_line];

        s_comm := Copy(fs_tpline, 1, 4);

        { set the beginning line of the program }
        if (fi_tpline = 0) and (s_comm <> 'VARI') then
            fi_tpline := i_line;

        i_command := Pos(s_comm, s_commands);
        if (i_command > 0) then
            i_index := ((i_command - 1) div 5) + 1
        else
        begin
            sz := 'Bad command line' + nl
            + IntToStr(i_line) + ' ' + fs_tpline;
            ShowMessage(sz);
            fb_terminate := true;
        end;

        if (i_index < 1) or (i_index > 255) then i_index := 0;
        fbytea_command[i_line] := byte(i_index);

        Inc(i_line);
    end;
end; { sub_commands_to_int }


procedure TForm1.sub_validate_commands;
{ updated 2007/04/14, 2007/01/19, 2006/05/02 }
{ 2006/05/12, 2006/04/30, 2006/04/29, 2005/03/22, 2004/10/19 }
var
    s_op1 : string;
    s_commands : string;
begin
    fb_error := false;

    fs_tpline := fsa_tpline[fi_tpline];

    s_op1 := Copy(fs_tpline, 1, 4);

    { validate the command }
    s_commands := ''
        + 'DABS,DARC,DCH$,DDEC,DED$,DFAC,DIF1,'
        + 'DIFT,DINC,DLOG,DPK$,DPOW,DRAN,DROU,'
        + 'DSEC,DSET,DSIN,DTO$,DTOF,DTOI,DTRU,DWHI,'

        + 'ELSE,ENDI,ENDP,ENDS,ENDW,ESUB,XXXX,EVAR,'
        + 'ITO$,ITOD,'

        + '$APP,$BAK,$BES,$CH$,$CHD,$CLO,$CNT,$COD,$CUP,'
        + '$CUT,$DAT,$DEL,$DOT,$IF1,$IFT,$INP,$INS,$ISC,'
        + '$ISD,$ISP,$IST,$LEN,$LOK,$OFF,$OUT,$PAR,$PKD,'
        + '$REP,$SET,$SHO,$SOR,$SWP,$SYS,$TLO,$TOD,$TOI,'
        + '$TRB,$TRL,$TRR,$TUP,$WHI,'

        + 'FDAT,FDEL,FLEN,FREN,'
        + 'FINP,FOUT,'
        + 'FSIP,FAPP,FADD,'
        + 'FREA,FWRI,'

        + 'QAPP,QINP,QOUT,QSET,QTOI,'
        + 'XXXX,XXXX,XXXX,XXXX,XXXX,'
        + 'ARRZ,ARRB,ADDI,DSYS,DBAD,'
        + '$TOE,$HSH,DBUG,DFAK,GOTO,'
        + 'GTAG,SUBR,VARI';


    if (Pos(s_op1, s_commands) = 0) or (Pos(',', s_op1) > 0)
    then fb_error := true;

    if (fs_tpline[5] <> ',') then fb_error := true;

    if fb_error then sub_error_in_prog_line('Bad command', fi_tpline);
end; { sub_validate_commands }


procedure TForm1.sub_validate_variables;
{ updated 2007/07/08, 2007/05/06, 2007/04/15, 2007/01/19 }
{ 2006/06/11, 2006/06/09, 2006/05/23, 2006/05/12, 2006/04/30 }
{ 2006/04/29, 2006/04/14, 2006/01/17, 2005/06/20, 2004/10/19 }
var
    iy, iz : integer;
    s_op1 : string;
    sy, sz : string;
    b_loop : boolean;
begin
    fb_error := false;

    fs_tpline := fsa_tpline[fi_tpline];

    s_op1 := Copy(fs_tpline, 1, 4);
    { COMM 00001S,00002S,00003S,00004S; }
    { 123456789012345678901234567890123 }

    { N means decimal literal or variable }
    { D means decimal variable }

    { $ means string literal or variable }
    { S means string variable }

    { a variable can give and receive values }
    { validate variables }
    if (s_op1 = 'DINC')
    or (s_op1 = 'DDEC')
    or (s_op1 = 'DSEC')
    or (s_op1 = 'DRAN') then
    begin
        sub_validate_variable(6, 'D');
        sub_validate_semicolon(12);
    end

    else if (s_op1 = '$DAT') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_semicolon(12);
    end

    else if (s_op1 = 'QTOI') then
    begin
        sub_validate_variable(6, 'N');
    end

    else if (s_op1 = 'QAPP')
    or (s_op1 = 'QINP')
    or (s_op1 = 'QSET') then
    begin
        sub_validate_variable(6, 'S');
    end

    else if (s_op1 = '$OUT')
    or (s_op1 = '$SHO') then
    begin
        sub_validate_append(6);
    end

    else if (s_op1 = '$SET')
    or (s_op1 = '$APP')
    or (s_op1 = '$INP') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_append(13);
    end

    else if (s_op1 = '$IFT')
    or (s_op1 = '$IF1')
    or (s_op1 = '$WHI') then
    begin
        sub_validate_variable(6, '$');
        sub_validate_variable(14, '$');
        sub_validate_semicolon(22);
    end

    else if (s_op1 = '$CLO')
    or (s_op1 = '$CUP')
    or (s_op1 = '$COD')
    or (s_op1 = '$BES')
    or (s_op1 = '$TLO')
    or (s_op1 = '$TRB')
    or (s_op1 = '$TRL')
    or (s_op1 = '$TRR')
    or (s_op1 = '$TUP')
    or (s_op1 = 'FINP') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, '$');
        sub_validate_semicolon(19);
    end

    else if (s_op1 = '$TOD')
    or (s_op1 = '$CHD')
    or (s_op1 = '$HSH')
    or (s_op1 = '$LEN')
    or (s_op1 = 'FDEL')
    or (s_op1 = '$ISD')
    or (s_op1 = 'FLEN') then
    begin
        sub_validate_variable(6, 'D');
        sub_validate_variable(13, '$');
        sub_validate_semicolon(19);
    end

    else if (s_op1 = '$TOI') then
    begin
        sub_validate_variable(6, 'N');
        sub_validate_variable(13, '$');
        sub_validate_semicolon(19);
    end

    else if (s_op1 = 'ITO$')
    or (s_op1 = '$SYS') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, 'N');
        sub_validate_semicolon(19);
    end

    else if (s_op1 = 'DIFT')
    or (s_op1 = 'DBAD')
    or (s_op1 = 'DIF1')
    or (s_op1 = 'DWHI') then
    begin
        sub_validate_variable(6, 'N');
        sub_validate_variable(14, 'N');
        sub_validate_semicolon(22);
    end

    else if (s_op1 = 'DLOG')
    or (s_op1 = 'DROU')
    or (s_op1 = 'DTRU')
    or (s_op1 = 'DABS')
    or (s_op1 = 'DSIN')
    or (s_op1 = 'DFAC')
    or (s_op1 = 'DSYS')
    or (s_op1 = 'DARC') then
    begin
        sub_validate_variable(6, 'D');
        sub_validate_variable(13, 'N');
        sub_validate_semicolon(19);
    end

    else if (s_op1 = 'DTOI')
    or (s_op1 = 'ADDI')
    or (s_op1 = 'ITOD') then
    begin
        sub_validate_variable(6, 'N');
        sub_validate_variable(13, 'N');
        sub_validate_semicolon(19);
    end

    else if (s_op1 = '$CH$')
    or (s_op1 = '$OFF')
    or (s_op1 = '$SOR') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, '$');
        sub_validate_variable(20, 'N');
        sub_validate_semicolon(26);
    end

    else if (s_op1 = '$INS')
    or (s_op1 = '$REP') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, 'N');
        sub_validate_variable(20, '$');
        sub_validate_semicolon(26);
    end

    else if (s_op1 = '$DEL')
    or (s_op1 = 'DTOF')
    or (s_op1 = 'DPK$')
    or (s_op1 = 'DCH$') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, 'N');
        sub_validate_variable(20, 'N');
        sub_validate_semicolon(26);
    end

    else if (s_op1 = 'DPOW')
    or (s_op1 = 'DFAK') then
    begin
        sub_validate_variable(6, 'D');
        sub_validate_variable(13, 'N');
        sub_validate_variable(20, 'N');
        sub_validate_semicolon(26);
    end

    else if (s_op1 = 'FDAT') then
    begin
        sub_validate_variable(6, 'D');
        sub_validate_variable(13, 'S');
        sub_validate_variable(20, '$');
        sub_validate_semicolon(26);
    end

    else if (s_op1 = 'FSIP') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, '$');
        sub_validate_variable(20, 'D');
        sub_validate_semicolon(26);
    end

    else if (s_op1 = '$SWP') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, '$');
        sub_validate_variable(20, '$');
        sub_validate_semicolon(26);
    end

    else if (s_op1 = 'FAPP')
    or (s_op1 = 'FADD')
    or (s_op1 = '$ISP')
    or (s_op1 = '$ISC')
    or (s_op1 = '$IST')
    or (s_op1 = '$CNT')
    or (s_op1 = 'FREN')
    or (s_op1 = 'FOUT') then
    begin
        sub_validate_variable(6, 'D');
        sub_validate_variable(13, '$');
        sub_validate_variable(20, '$');
        sub_validate_semicolon(26);
    end

    else if (s_op1 = '$CUT')
    or (s_op1 = 'FREA') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, '$');
        sub_validate_variable(20, 'N');
        sub_validate_variable(27, 'N');
        sub_validate_semicolon(33);
    end

    else if (s_op1 = '$LOK')
    or (s_op1 = 'FWRI')
    or (s_op1 = '$BAK') then
    begin
        sub_validate_variable(6, 'D');
        sub_validate_variable(13, '$');
        sub_validate_variable(20, 'N');
        sub_validate_variable(27, '$');
        sub_validate_semicolon(33);
    end

    else if (s_op1 = '$DOT') then
    begin
        sub_validate_variable(6, 'D');
        sub_validate_variable(13, '$');
        sub_validate_variable(20, '$');
        sub_validate_variable(27, 'N');
        sub_validate_semicolon(33);
    end

    else if (s_op1 = 'DTO$')
    or (s_op1 = 'DED$') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, 'N');
        sub_validate_variable(20, 'N');
        sub_validate_variable(27, 'N');
        sub_validate_semicolon(33);
    end

    else if (s_op1 = '$PAR')
    or (s_op1 = '$TOE') then
    begin
        sub_validate_variable(6, 'S');
        sub_validate_variable(13, '$');
        sub_validate_variable(20, '$');
        sub_validate_variable(27, 'N');
        sub_validate_semicolon(33);
    end
    else if (s_op1 = 'DSET') then
    begin
        { 123456789012345678901234567890 }
        { DSET 00401p=+00402p-00403p*00404p/00405p; }

        if (fs_tpline[12] <> '=') then fb_error := true;
        if (Pos(fs_tpline[13], '+-') = 0) then fb_error := true;

        sub_validate_variable(6, 'D');

        iz := 13;
        b_loop := true;

        while not fb_error and b_loop do
        begin
            if (Length(fs_tpline) >= (iz + 7)) then
            begin
                { validate the operator }
                if (Pos(fs_tpline[iz], '+-*/%\^@?') = 0) then fb_error := true;

                { validate the variable }
                sub_validate_variable(Succ(iz), 'N');

                Inc(iz, 7);
                if (fs_tpline[iz] = ';') then b_loop := false;
            end
            else fb_error := true;
        end;
    end; { DSET }

    { validate if and while compare operator }
    if (s_op1 = 'DIF1')
    or (s_op1 = 'DIFT')
    or (s_op1 = 'DWHI')
    or (s_op1 = 'DBAD')
    or (s_op1 = '$IF1')
    or (s_op1 = '$IFT')
    or (s_op1 = '$WHI') then
    begin
        { 1234567890123456789012 }
        { DIFT 00401p==00001n,1, }
        sz := Copy(fs_tpline, 12, 2);
        if (Pos(sz, '== <> << >> <= >=') = 0) then fb_error := true;
    end;

    { save last sub name to help in case of error }
    if (s_op1 = 'SUBR') then fs_subr_name := fs_tpline;

    if fb_error then sub_error_in_prog_line('Bad variable', fi_tpline);
end; { sub_validate_variables }


procedure TForm1.sub_validate_semicolon(const pbyte_1 : byte);
{ updated 2002/04/20 }
var
    s_rec : string;
begin
    s_rec := fsa_tpline[fi_tpline];

    if (s_rec[pbyte_1] <> ';') then fb_error := true;
end; { sub_validate_semicolon }


procedure TForm1.sub_error_in_prog_line(
    const ps1 : string;
    const pi2 : integer);
{ updated 2006/04/30, 2003/04/21 }
var
    sz : string;
    i_beg, i_end : integer;
    iy, iz : integer;
begin
    { ps1 has an error message in it }
    sz := ps1 + ' in ' + fs_subr_name
        + ' Error in prog line=' + nl
        + IntToStr(pi2) + ': '
        + fsa_tpline[pi2] + nl;

    { show a few lines before and after }
    i_beg := pi2 - 8;
    i_end := i_beg + 8;

    sz := sz + nl + fns_tplines_to_show(i_beg, i_end);

    sub_more_or_halt(sz);
end; { sub_error_in_prog_line }


procedure TForm1.sub_validate_variable(
    const pi1 : integer;
    const ps2 : string);
{ updated 2002/04/20 }
{ validate variable at pi1 in fs_tpline of type ps3=S,N,D }
var
    iy, iz : integer;
    s_var : string;
    sz : string;
begin
    { 123456 }
    { 00101N }
    s_var := Copy(fs_tpline, pi1, 6) + StringOfChar(' ', 6);

    { C = single character }
    { D = local decimal }
    { G = global decimal }
    { N = literal number }
    { R = global string }
    { S = local string }

    { $ means a real string }
    if (ps2 = '$') then
    begin
        if (Pos(s_var[6], 'CRS') = 0) then fb_error := true;
    end

    { S means only a variable string will do }
    else if (ps2 = 'S') then
    begin
        if (Pos(s_var[6], 'RS') = 0) then fb_error := true;
    end

    { N means a number of any kind }
    else if (ps2 = 'N') then
    begin
        if (Pos(s_var[6], 'DGN') = 0) then fb_error := true;
    end

    { D means only a variable number will do }
    else if (ps2 = 'D') then
    begin
        if (Pos(s_var[6], 'DG') = 0) then fb_error := true;
    end;

    { is s_var actually numeric }
    iz := StrToIntDef(Copy(s_var, 1, 5), -1);
    if (iz = -1) then fb_error := true;
end; { sub_validate_variable }


procedure TForm1.sub_validate_append(const pi1 : integer);
{ updated 2002/12/01 }
{ validate a string append expression }
var
    s_line : string;
    b_loop : boolean;
    iz : integer;
begin
    s_line := Copy(fs_tpline, pi1, 200);

    b_loop := true;

    { C = single character }
    { D = local decimal }
    { G = global decimal }
    { N = literal number }
    { R = global string }
    { S = local string }

    while b_loop do
    begin
        { do we have a valid string variable }
        if (Length(s_line) < 7) then fb_error := true
        else
        begin
            { validate the string link as a number }
            iz := StrToIntDef(Copy(s_line, 1, 5), -1);
            if (iz = -1) then fb_error := true;
            if (Pos(s_line[6], 'CDGNRS') = 0) then fb_error := true;

            if (Length(s_line) > 7) then
            begin
                if (s_line[7] <> '+') then fb_error := true;
                s_line := Copy(s_line, 8, 200);
            end
            else
            begin
                if (s_line[7] <> ';') then fb_error := true;
                b_loop := false;
            end;
        end;

        if fb_error then b_loop := false;
    end;
end; { sub_validate_append }


procedure TForm1.sub_more_or_halt(const ps1 : string);
{ updated 2000/01/01 }
begin
    if not fnb_more(ps1) then sub_terminate;
end; { sub_more_or_halt }


function TForm1.fnb_more(const ps1 : string) : boolean;
{ updated 2000/01/01 }
var
    iz : integer;
begin
    iz := MessageDlgPos(ps1, mtCustom, mbOkCancel, 0, 100, 0);
    if (iz = mrCancel) then Result := false
    else Result := true;
end; { fnb_more }


function TForm1.fni_yesnocancel(const ps1 : string) : integer;
{ updated 2003/07/26 }
var
    i_result : integer;
    iz : integer;
begin
    { 1=yes, 2=no, 0=cancel }
    iz := MessageDlgPos(ps1, mtCustom, mbYesNoCancel, 0, 100, 0);

    i_result := 0;
    if (iz = mrYes) then i_result := 1;
    if (iz = mrNo) then i_result := 2;

    Result := i_result;
end; { fni_yesnocancel }


function TForm1.fns_tplines_to_show(const pi1, pi2 : integer) : string;
{ updated 2006/04/30, 2003/07/26 }
var
    i_beg, i_end : integer;
    s_result : string;
    sy, sz : string;
    iz : integer;
begin
    i_beg := pi1;
    i_end := pi2;
    s_result := '';

    if (i_beg < 1) then i_beg := 1;
    if (i_end > fi_tpline_last) then i_end := fi_tpline_last;
    if (i_end < i_beg) then i_end := i_beg;

    for iz := i_beg to i_end do
    begin
        { put extra nl before SUBR }
        sz := Copy(fsa_tpline[iz], 1, 4);
        if (sz = 'SUBR') then s_result := s_result + nl;

        sz := IntToStr(iz) + ': ' + fsa_tpline[iz];

        s_result := s_result + sz + nl;
    end;

    Result := s_result;
end; { fns_tplines_to_show }


procedure TForm1.sub_link_first_parameter;
{ updated 2007/04/16, 2000/01/01 }
var
    s_notcommands : string;
    s_command : string;
begin
    s_notcommands := 'DIFT,DWHI,$IFT,$WHI,ENDI,ENDW,ELSE,ESUB,GOTO';
    fi_tpline := 1;

    while (fi_tpline < fi_tpline_last) do
    begin
        { get a record }
        fs_tpline := fsa_tpline[fi_tpline];
        s_command := Copy(fs_tpline, 1, 4);

        { do we want to link the first parameter of this command }
        if (Pos(s_command, s_notcommands) = 0) then
            { 12345678901 }
            { NINC 12345p }
            fia_link[fi_tpline] := StrToIntDef(Copy(fs_tpline, 6, 5), 0);

        Inc(fi_tpline);
    end;
end; { sub_link_first_parameter }


procedure TForm1.sub_link_dift_sift;
{ updated 2003/03/16 }
{ link the if and while type commands }
var
    s_rec : string;
    i_rec : integer;
    i_above : integer;
    sa_stack : array[1..1000] of string;
    ia_stack : array[1..1000] of integer;
    i_stack : integer;
    s_comm : string;
    i_last_endi : integer;
    iz : integer;
    sz : string;
    b_loop : boolean;
    b_error : boolean;
begin
    { initialize the stack }
    for iz := 1 to 1000 do
    begin
        sa_stack[iz] := '';
        ia_stack[iz] := 0;
    end;

    { initialize the link array }
    for iz := 1 to fi_tpline_last do
        fia_link[iz] := fi_tpline_last;

    { read through the program and build the stack }
    i_stack := 0;
    fs_subr_name := 'Not in a subr;';

    i_rec := 1;
    b_loop := true;

    while b_loop and not fb_terminate do
    begin
        b_error := false;

        { get a record }
        s_rec := fsa_tpline[i_rec];
        s_comm := Copy(s_rec, 1, 4);

        if (s_comm = 'DWHI') or (s_comm = '$WHI') then
        begin
            Inc(i_stack);
            sa_stack[i_stack] := 'DWHI';
            ia_stack[i_stack] := i_rec;
        end
        else if (s_comm = 'ENDW') then
        begin
            if (sa_stack[i_stack] = 'DWHI') then
            begin
                i_above := ia_stack[i_stack];
                fia_link[i_rec] := Pred(i_above);
                fia_link[i_above] := i_rec;
            end
            else b_error := true;

            Dec(i_stack);
        end
        else if (s_comm = '$IFT') or (s_comm = 'DIFT') then
        begin
            Inc(i_stack);
            sa_stack[i_stack] := 'DIFT';
            ia_stack[i_stack] := i_rec;
        end
        else if (s_comm = 'ELSE') then
        begin
            if (sa_stack[i_stack] = 'DIFT') then
            begin
                i_above := ia_stack[i_stack];
                fia_link[i_above] := i_rec;
                ia_stack[i_stack] := i_rec;
                sa_stack[i_stack] := 'ELSE';
            end
            else b_error := true;
        end
        else if (s_comm = 'ENDI') then
        begin
            { the last endi is when we have more than 1 }
            i_last_endi := fni_link_last_endi(i_rec);
            fia_link[i_rec] := i_last_endi;

            if (sa_stack[i_stack] = 'DIFT')
            or (sa_stack[i_stack] = 'ELSE') then
            begin
                i_above := ia_stack[i_stack];
                fia_link[i_above] := i_last_endi;
            end
            else b_error := true;

            Dec(i_stack);
        end
        else if (s_comm = 'SUBR') then
        begin
            if (i_stack <> 0) then b_error := true;

            fs_subr_name := Copy(s_rec, 6, 50);
        end
        else if (s_comm = 'ENDS') and (i_stack <> 0) then
            b_error := true;

        if (i_stack < 0) then b_error := true;

        if b_error then sub_error_in_prog_line('ENDS,ENDI,ENDW', i_rec);

        Inc(i_rec);
        if (i_rec > fi_tpline_last) then b_loop := false;
    end;
end; { sub_link_dift_sift }


function TForm1.fni_link_last_endi(const pi_rec : integer) : integer;
{ updated 2003/03/16 }
var
    { find record number of last of series of endi }
    i_last : integer;
    i_rec : integer;
    b_loop : boolean;
    s_comm : string;
begin
    i_rec := pi_rec;
    i_last := pi_rec;
    b_loop := true;

    while b_loop do
    begin
        s_comm := Copy(fsa_tpline[i_rec], 1, 4);
        if (s_comm = 'ENDI') then i_last := i_rec
        else b_loop := false;

        Inc(i_rec);
        if (i_rec > fi_tpline_last) then b_loop := false;
    end;

    Result := i_last;
end; { fni_link_last_endi }


procedure TForm1.sub_link_subroutines;
{ updated 2007/04/15, 2007/04/14, 2004/10/27 }
var
    sa_subnames : array[1..1000] of string;
    ia_sublinelinks : array[1..1000] of integer;
    i_subindex : integer;
    s_goto : string;
    s_gtag : string;
    s_command : string;
    s_restofline : string;
    s_subname : string;
    i_lastevar : integer;
    i_nextends : integer;
    iy, iz : integer;
    sy, sz : string;
    b_insub : boolean;
    b_loop1 : boolean;
    b_loop2 : boolean;
begin
    { initialize the stack }
    for iz := 1 to 1000 do
    begin
        sa_subnames[iz] := '';
        ia_sublinelinks[iz] := 0;
    end;

    { read through the program and build the subroutine stack }
    fi_subroutine_ct := 0;
    s_subname := 'SUB_NOT';
    i_subindex := 1;
    fi_tpline := 1;
    b_insub := false;
    i_lastevar := 0;
    b_loop1 := true;

    while b_loop1 and not fb_terminate do
    begin
        { get program line }
        fs_tpline := fsa_tpline[fi_tpline];
        s_command := Copy(fs_tpline, 1, 4);
        s_restofline := Trim(Copy(fs_tpline, 6, 80));

        if (s_command = 'EVAR') and (i_lastevar = 0)
        then i_lastevar := fi_tpline;

        if (s_command = 'ENDS') then
        begin
            if not b_insub then
            begin
                ShowMessage('ENDS but not in sub');
                fb_terminate := true;
            end;

            b_insub := false;
            s_subname := '';
        end;

        if (s_command = 'SUBR') then
        begin
            if b_insub then
            begin
                ShowMessage('no ENDS for=' + s_subname);
                fb_terminate := true;
            end;

            b_insub := true;
            Inc(fi_subroutine_ct);

{ sa_subnames has the names of the subs }
{ ia_sublinelinks has the last VARI line number in it }
{ i_subindex is the index for sa_subnames,ia_sublinelinks }
            { subroutine names can be upto 64 long }
            s_subname := s_restofline;

            if (Length(s_subname) > 64) then
            begin
                ShowMessage('long SUBR name=' + s_subname);
                fb_terminate := true;
            end;

            { do we already have this sub }
            for iz := 1 to Pred(i_subindex) do
            begin
                if (sa_subnames[iz] = s_subname) then
                begin
                    ShowMessage('dup SUBR=' + s_subname);
                    fb_terminate := true;
                end;
            end;

            sa_subnames[i_subindex] := s_subname;

            { find the last VARI line number for this sub }
            iz := Succ(fi_tpline);
            i_lastevar := iz;
            i_nextends := 0;
            b_loop2 := true;

            while b_loop2 do
            begin
                sz := Copy(fsa_tpline[iz], 1, 4);

                if (sz = 'EVAR') then i_lastevar := iz;
                if (sz = 'ENDS') then
                begin
                    i_nextends := iz;
                    b_loop2 := false;
                end;

                Inc(iz);
                if (iz >= fi_tpline_last) then b_loop2 := false;
            end;

            { ia_sublinelinks is for the last VARI line number }
            ia_sublinelinks[i_subindex] := Pred(i_lastevar);

{ sa_subnames has the names of the subs }
{ ia_sublinelinks has the last VARI line number in it }
{ i_subindex is the index for sa_subnames,ia_sublinelinks }
            Inc(i_subindex);
            if (i_subindex > 1000) then
            begin
                ShowMessage('> 1000 of SUBR');
                fb_terminate := true;
            end;
        end;

        if (s_command = 'GOTO') then
        begin
            s_goto := s_restofline;

            if (Length(s_subname) = 0) then
            begin
                ShowMessage('GOTO but not in sub');
                fb_terminate := true;
            end;

            if (Copy(s_goto, 1, 4) <> 'TAG_') then
            begin
                ShowMessage('GOTO not to TAG_');
                fb_terminate := true;
            end;

            { find the GTAG for this GOTO }
            iz := i_lastevar;
            b_loop2 := true;

            while b_loop2 do
            begin
                sz := Copy(fsa_tpline[iz], 1, 4);
                sy := Trim(Copy(fsa_tpline[iz], 6, 80));

                if (sz = 'GTAG') and (sy = s_goto) then
                begin
                    if (fia_link[fi_tpline] <> fi_tpline_last) then
                    begin
                        ShowMessage('dup GTAG=' + sy);
                        fb_terminate := true;
                    end;

                    fia_link[fi_tpline] := iz;
                end;

                if (sz = 'ENDS') or (sz = 'SUBR') then b_loop2 := false;

                Inc(iz);
                if (iz >= i_nextends) then b_loop2 := false;
            end;

            if (fia_link[fi_tpline] = fi_tpline_last) then
            begin
                ShowMessage('not GTAG=' + sy);
                fb_terminate := true;
            end;
        end;

        if (s_command = 'GTAG') then
        begin
            s_gtag := s_restofline;

            if (Length(s_subname) = 0) then
            begin
                ShowMessage('GTAG but not in sub');
                fb_terminate := true;
            end;

            if (Copy(s_gtag, 1, 4) <> 'TAG_') then
            begin
                ShowMessage('GTAG name not TAG_');
                fb_terminate := true;
            end;
        end;

        Inc(fi_tpline);
        if (fi_tpline >= fi_tpline_last) then b_loop1 := false;
    end;

    { read through the program and link the ESUB,GTAG lines }
    fi_tpline := 1;
    b_loop1 := true;

    while b_loop1 and not fb_terminate do
    begin
        { get program line }
        fs_tpline := fsa_tpline[fi_tpline];
        s_command := Copy(fs_tpline, 1, 4);
        s_restofline := Trim(Copy(fs_tpline, 6, 80));

        if (s_command = 'ESUB') then
        begin
{ sa_subnames has the names of the subs }
{ ia_sublinelinks has the last VARI line number in it }
{ i_subindex is the index for sa_subnames,ia_sublinelinks }
            { subroutine names can be upto 64 long }
            s_subname := s_restofline;

            { find this s_subname to get the linkline }
            i_subindex := 1;
            b_loop2 := true;

            while b_loop2 and not fb_terminate do
            begin
                if (s_subname = sa_subnames[i_subindex]) then
                begin
                    { link this sub }
                    fia_link[fi_tpline] := ia_sublinelinks[i_subindex];
                    b_loop2 := false;
                end;

                if b_loop2 then Inc(i_subindex);
                if (i_subindex > 1000) then
                begin
                    ShowMessage('no SUBR for=' + s_subname);
                    fb_terminate := true;
                end;
            end;
        end;

        Inc(fi_tpline);
        if (fi_tpline >= fi_tpline_last) then b_loop1 := false;
    end;

end; { sub_link_subroutines }


procedure TForm1.sub_link_variable_names;
{ updated 2004/01/24 }
{ replace variable names with location links }
var
    i_global : integer;
    sa_name : array[1..2000] of string;
    sa_link : array[1..2000] of string;
    s_line : string;
    s_comm : string;
    i_record : integer;
    i_name : integer;
    s_name, s_link : string;
    s_char : string;
    i_long : integer;
    i_var_d, i_var_s : integer;
    iy, iz : integer;
    sy, sz : string;
    b_loop1, b_loop2 : boolean;
    b_update : boolean;
    b_in_sub : boolean;
    b_error1, b_error_all : boolean;
    s_error : string;
begin
    { initialize the local variable counters for EVAR }
    i_var_d := fi_literal_decimals;
    i_var_s := fi_literal_strings;

    fs_subr_name := 'Not in sub';

    { initialize }
    for iz := 1 to 2000 do
    begin
        sa_name[iz] := '';
        sa_link[iz] := '';
    end;
    { make the character set }
    s_char := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_';

    { 1234567890123456789012345678 }
    { VARI s_rec,s_name,ncnt1,dnum1 }

    { get the variable names }
    i_global := 0;
    b_in_sub := false;
    i_record := 1;
    i_name := 0;
    b_loop1 := true;

    while b_loop1 and not fb_terminate do
    begin
        s_line := fsa_tpline[i_record];
        s_comm := Copy(s_line, 1, 4);

        { do we need to put the count of the local variables in EVAR }
        if (s_comm = 'EVAR') then
        begin
            sz := IntToStr(i_var_d);
            sz := StringOfChar('0', 5 - Length(sz)) + sz;
            sy := 'EVAR,' + sz + 'N,';

            sz := IntToStr(i_var_s);
            sz := StringOfChar('0', 5 - Length(sz)) + sz;
            sy := sy + sz + 'N;';

            fsa_tpline[i_record] := sy;

            { initialize the local variable counters for EVAR }
            i_var_d := 0;
            i_var_s := 0;
        end;

        if (s_comm = 'VARI') then
        begin
            s_line := Copy(s_line, 6, 500);

            { take off the semi-colon }
            iz := Pos(';', s_line);
            s_line := Copy(s_line, 1, Pred(iz));

            b_loop2 := true;
            while b_loop2 do
            begin
                b_error_all := false;

                iz := Pos(',', s_line);
                if (iz = 0) then
                begin
                    s_name := s_line;
                    s_line := '';
                end
                else
                begin
                    { we should already have UpperCase }
                    s_name := Trim(Copy(s_line, 1, Pred(iz)));

                    { prepare for next time }
                    s_line := Trim(Copy(s_line, Succ(iz), 500));
                end;

                { validate the length }
                i_long := Length(s_name);
                if (i_long < 5) or (i_long > 64) then
                begin
                    b_error_all := true;
                    sz := 'Length of name bad=' + s_name;
                    sub_error_in_prog_line(sz, i_record);
                end;

                { is this a valid name }
                b_error1 := false;

                if (Pos(s_name[1], 'DS') = 0) then b_error1 := true;

                { test for all valid characters }
                for iy := 1 to i_long do
                    if (Pos(s_name[iy], s_char) = 0) then b_error1 := true;

                if b_in_sub then
                begin
                    if (s_name[2] <> '_') then b_error1 := true;
                end
                else
                begin
                    if (s_name[2] <> 'G') or (s_name[3] <> '_') then
                        b_error1 := true;
                end;

                if b_error1 then
                begin
                    b_error_all := true;
                    sz := 'Bad name=' + s_name;
                    sub_error_in_prog_line(sz, i_record);
                end;

                { do we have an overlapping name, i_global is the last global }
                b_error1 := false;
                for iy := 1 to i_name do
                begin
                    if (Pos(s_name, sa_name[iy]) > 0)
                       or (Pos(sa_name[iy], s_name) > 0) then
                    begin
                        s_error := s_name + ' / ' + sa_name[iy];
                        b_error1 := true;
                    end;
                end;

                if b_error1 then
                begin
                    b_error_all := true;
                    sz := 'Overlapping name=' + s_error;
                    sub_error_in_prog_line(sz, i_record);
                end;

                if not b_error_all and (i_name < 2000) then
                begin
                    Inc(i_name);
                    if not b_in_sub then Inc(i_global);

                    sa_name[i_name] := s_name;

                    { build the link }
                    if (s_name[1] = 'S') then
                    begin
                        if b_in_sub then
                        begin
                            { local variables }
                            Inc(i_var_s);
                            s_link := IntToStr(i_var_s) + 'S'
                        end
                        else
                        begin
                            { global variables }
                            Inc(i_var_s);
                            Inc(fi_svar);
                            s_link := IntToStr(i_var_s) + 'R';
                            Inc(fi_global_strings);
                        end;
                    end
                    else
                    begin
                        if b_in_sub then
                        begin
                            { local variables decimal }
                            Inc(i_var_d);
                            s_link := IntToStr(i_var_d) + 'D'
                        end
                        else
                        begin
                            { global variables decimal }
                            Inc(i_var_d);
                            Inc(fi_dvar);
                            s_link := IntToStr(i_var_d) + 'G';
                            Inc(fi_global_decimals);
                        end;
                    end;
                    s_link := StringOfChar('0', 6 - Length(s_link)) + s_link;
                    sa_link[i_name] := s_link;
                end;

                if (Length(s_line) = 0) then b_loop2 := false;
            end; { b_loop2 }
        end
        else if (s_comm = 'SUBR') then
        begin
            b_in_sub := true;
            fs_subr_name := Copy(s_line, 6, 50);

            { wipe out the local variables from the previous sub }
            for iy := Succ(i_global) to 2000 do
            begin
                sa_name[iy] := '';
                sa_link[iy] := '';
                i_name := i_global;
            end;

            { reset the link variables for local variables }
            i_var_d := 0;
            i_var_s := 0;
        end
        else if (s_comm <> 'ESUB') then
        begin
            { replace names with links }
            { go backwards so local variables will have precedence }
            b_error1 := false;
            for iz := i_name DownTo 1 do
            begin
                s_name := sa_name[iz];
                s_link := sa_link[iz];
                i_long := Length(s_name);

                b_update := false;
                b_loop2 := true;

                while b_loop2 do
                begin
                    iy := Pos(s_name, s_line);
                    if (iy > 0) then
                    begin
                        { is name in s_line too long }
                        { is next char a legal name char }
                        if (Pos(s_line[iy + i_long], s_char) > 0) then
                        begin
                            b_error_all := true;
                            sz := 'Bad name=' + s_name;
                            sub_error_in_prog_line(sz, i_record);
                        end;

                        { put s_link in place of s_name }
                        s_line := Copy(s_line, 1, Pred(iy)) + s_link
                            + Copy(s_line, iy + i_long, 200);
                        b_update := true;
                    end
                    else b_loop2 := false;
                end; { b_loop2 }

                if b_update then fsa_tpline[i_record] := s_line;
            end;
        end;

        Inc(i_record);
        if (i_record > fi_tpline_last) then b_loop1 := false;
    end; { b_loop1 }
end; { sub_link_variable_names }


procedure TForm1.sub_old_to_new;
{ updated 2004/12/03 }
{ translate old commands to new }
var
    s_record : string;
    s_comm : string;
    i_line : integer;
begin
    i_line := 1;

    while (i_line <= fi_tpline_last) do
    begin
        s_record := fsa_tpline[i_line];
        s_comm := UpperCase(Copy(s_record, 1, 4));

        if (s_comm = 'DPRI') then s_comm := 'DFAC';
        if (s_comm = 'CSWP') then s_comm := '$SWP';
        if (s_comm = '$PTT') then s_comm := '$ISP';
        if (s_comm = 'FGET') then s_comm := 'FREA';
        if (s_comm = 'FPUT') then s_comm := 'FWRI';

        s_record := s_comm + Copy(s_record, 5, 99999);
        fsa_tpline[i_line] := s_record;

        Inc(i_line);
    end;
end; { sub_old_to_new }


procedure TForm1.sub_initialize;
{ updated 2007/10/16 }
{ 2007/09/17, 2007/06/16, 2006/04/30, 2006/04/29, 2004/01/24 }
var
    iz : integer;
begin
    { initialize program info variables }
    fi_prog_lines := 0;
    fd_total_lines := 0;
    fi_max_length := 100000000;
    fi_max_dvar := 2000;
    fi_max_svar := 4000;
    fi_max_darray := 8000;
    fi_max_sarray := 2000;

    { string variable counts }
    fi_svar := 0;
    fi_literal_strings := 0;
    fi_global_strings := 0;

    { decimal variable counts }
    fi_dvar := 0;
    fi_literal_decimals := 0;
    fi_global_decimals := 0;

    { initialize the program array }
    for iz := 1 to 15000 do
    begin
        fsa_tpline[iz] := '';
        fbytea_command[iz] := 0;
        fia_link[iz] := 0;
    end;

    { initialize }
    for iz := 1 to fi_max_svar do
    begin
        fsa_var[iz] := '';
    end;

    for iz := 1 to fi_max_dvar do
    begin
        fea_var[iz] := 0;
    end;

    for iz := 1 to fi_max_darray do
    begin
        fea_array[iz] := 0;
    end;

    for iz := 1 to fi_max_sarray do
    begin
        fsa_array[iz] := '';
    end;

    { initialize the array arrays }
    for iz := 1 to 1000 do
    begin
        { some stacks }
        fia_delta_s[iz] := 0;
        fia_delta_d[iz] := 0;
        fia_sub[iz] := 0;
    end;

    { dynamic memory }
    fii_delta_s := 1;
    fii_delta_d := 1;
    fi_delta_s := 0;
    fi_delta_d := 0;
    fii_sub := 0;

    fi_max_delta_s := 0;
    fi_max_delta_d := 0;
    fi_max_sub := 0;

    for iz := 1 to 30 do fsa_show[iz] := '';
end; { sub_initialize }


procedure TForm1.sub_tpprog_build_array;
{ updated 2007/06/16, 2006/06/11, 2004/10/11 }
var
    file_text : TextFile;
    i_record : integer;
    s_record : string;
    s_rec1, s_rec2 : string;
    s_actualcode : string;
    s_comm1, s_comm2 : string;
    i_long : integer;
    iz : integer;
    sy, sz : string;
    b_two : boolean;
    b_good : boolean;
    b_loop : boolean;
begin
    fi_comment_ct := 0;
    AssignFile(file_text, fs_tpprog_name);

    { set for read only access }
    FileMode := 0;

    {$I-}
    Reset(file_text);
    {$I+}

    if (IOResult = 0) then
    begin
        { put in system variables }
        s_comm1 := '';

        fi_tpline_last := 1;
        i_record := 1;
        fi_line := 0;

        while not Eof(file_text) and not fb_terminate do
        begin
            { read a line of the program }
            Readln(file_text, s_record);
            Inc(fi_line);

            if fb_debug then
            begin
                application.processmessages;
                label_show.caption := inttostr(fi_line) + ' '
                + IntToStr(i_record) + ' '
                + trim(s_record);

                application.processmessages;
            end;

            { blank char < 32 }
            s_record := Trim(fns_blank_escapes(s_record));

            b_good := true;
            b_two := false;

            if (Length(s_record) < 1) then b_good := false;

            { skip over comment lines which begin with an apostrophe }
            if b_good and (s_record[1] = '''') then
            begin
                Inc(fi_comment_ct);
                b_good := false;
            end;
            if b_good and (s_record[1] = '<') then
            begin
                Inc(fi_comment_ct);
                b_good := false;
            end;


            { eliminate extra blanks and put commas after commands }
            { also make upper case except for literal strings }
            s_actualcode := '';
            if b_good then s_actualcode := fns_eliminate_blanks(s_record);


            s_record := s_actualcode;

            i_long := Length(s_record);
            if b_good then
            begin
                { link the literal strings into fsa_var }
                s_record := fns_link_literal_strings(s_record);

                { split into two records if needed }
                s_rec1 := s_record;
                s_rec2 := '';
                sub_tpline_split(s_rec1, s_rec2);

                if (Length(s_rec2) > 0) then b_two := true
                else b_two := false;

                { put in DSET,$SET,ESUB and semi-colon at end }
                s_rec1 := fns_tpline_format(s_rec1);
                if b_two then s_rec2 := fns_tpline_format(s_rec2);

                { link the literal numbers into fda_var }
                s_rec1 := fns_link_literal_numbers(s_rec1);
                if b_two then s_rec2 := fns_link_literal_numbers(s_rec2);

                s_comm2 := s_comm1;
                s_comm1 := Copy(s_rec1, 1, 4);

                { do we need a EVAR for no global variables }
                if (i_record = 1) and (s_comm1 <> 'VARI') then
                begin
                    fsa_tpline[i_record] := 'EVAR,00000N,00000N;';
                    Inc(i_record);
                end;

                { do we need a EVAR line to setup local variables }
                if (s_comm2 = 'VARI') or (s_comm2 = 'SUBR') then
                begin
                    if (s_comm1 <> 'VARI') then
                    begin
                        fsa_tpline[i_record] := 'EVAR,00000N,00000N;';
                        Inc(i_record);
                    end;
                end;

                { store lines in fsa_tpline }
                fsa_tpline[i_record] := s_rec1;
                if b_two then
                begin
                    Inc(i_record);
                    fsa_tpline[i_record] := s_rec2;
                end;

                Inc(i_record);
                if (i_record > 15000) then
                begin
                    sz := 'Program over 15000 lines';
                    sub_error_in_prog_line(sz, 15000 - 10);
                end;
            end;
        end;

        fi_tpline_last := i_record;
        fi_prog_lines := i_record;
        fsa_tpline[i_record] := 'ENDP,';

        CloseFile(file_text);
    end
    else
    begin
        sz := 'Cannot open file=' + fs_tpprog_name;
        ShowMessage(sz);
        sub_terminate;
    end;
end; { sub_tpprog_build_array }


function TForm1.fns_link_literal_strings(const ps_rec : string)
: string;
{ updated 2007/06/16, 2006/06/11, 2004/10/11 }
{ link literal strings to indexes in fsa_var }
var
    s_link : string;
    s_string : string;
    s_line : string;
    i_record : integer;
    b_loop : boolean;
    i_beg, i_long : integer;
    s_rest : string;
    c_beg : char;
    i1, i2 : integer;
begin
    s_line := ps_rec;
    b_loop := true;

    { literal strings can be delimited by " and by # }
    while b_loop do
    begin
        { look for double quotes and for # }
        i1 := Pos('"', s_line);
        i2 := Pos('#', s_line);

        if (i1 = 0) then i1 := 99999;
        if (i2 = 0) then i2 := 99999;
        i_beg := 99999;

        if (i1 < i_beg) then
        begin
            i_beg := i1;
            c_beg := '"';
        end;

        if (i2 < i_beg) then
        begin
            i_beg := i2;
            c_beg := '#';
        end;

        if (i_beg = 99999) then
        begin
            i_beg := 0;
            b_loop := false;
        end;

        if b_loop then
        begin
            { get the literal string }
            s_rest := Copy(s_line, Succ(i_beg), 200);

            { find i_long which is actually length + 1 }
            i_long := Pos(c_beg, s_rest);

            { did we find the other c_beg = " or # }
            if (i_long < 1) then b_loop := false
            else
            begin
                { we have the string }
                s_string := Copy(s_rest, 1, Pred(i_long));

                { do we have a single character }
                if (Length(s_string) = 1) then
                begin
                    s_link := '00000' + IntToStr(Ord(s_string[1])) + 'C';
                    s_link := Copy(s_link, Length(s_link) - 5, 6);

                    { delete the string from s_line }
                    Delete(s_line, i_beg, Succ(i_long));

                    { insert the link into the string }
                    Insert(s_link, s_line, i_beg);
                end
                else if (fi_svar < fi_max_svar) then
                begin
                    { get the string literal link }
                    Inc(fi_svar);
                    Inc(fi_literal_strings);

                    { save the literal string }
                    fsa_var[fi_svar] := s_string;

                    { prepare the link as a global variable }
                    s_link := '00000' + IntToStr(fi_svar) + 'R';
                    s_link := Copy(s_link, Length(s_link) - 5, 6);

                    { delete the string from s_line }
                    Delete(s_line, i_beg, Succ(i_long));

                    { insert the link into the string }
                    Insert(s_link, s_line, i_beg);
                end
                else
                begin
                    sub_program_error('too many literal strings');
                end;
            end;
        end;
    end; { b_loop }

    { send the result back }
    Result := s_line;
end; { fns_link_literal_strings }


procedure TForm1.sub_tpline_split(var s_rec1, s_rec2 : string);
{ updated 2004/10/11 }
{ split a line into two if needed }
var
    s_line : string;
    iz : integer;
    sz : string;
begin
    { string literals have been removed }
    s_rec2 := '';

    s_line := s_rec1;
    sz := Copy(s_line, 1, 4);

    if (sz = 'DIFT') or (sz = '$IFT') then
    begin
        iz := Pos(':', s_line);
        if (iz > 0) then
        begin
            { we need to split the line }
            s_rec1 := Trim(Copy(s_line, 1, Pred(iz)));

            { change DIFT,$IFT to DIF1,$IF1 }
            s_rec1[4] := '1';

            s_rec2 := Trim(Copy(s_line, Succ(iz), 9999));
        end;
    end;
    { s_rec1,s_rec2 are variable parameters }
end; { sub_tpline_split }


function TForm1.fns_tpline_format(const ps1 : string) : string;
{ updated 2004/10/11 }
{ put in DSET,$SET,ESUB and semi-colon at end }
var
    s_line : string;
    sy, sz : string;
    iz : integer;
begin
    s_line := ps1 + ' ';

    { prefix DSET, if needed }
    sz := Copy(s_line, 1, 2);
    sy := Copy(s_line, 1, 3);
    if (sz = 'D_') or (sy = 'DG_') then s_line := 'DSET,' + s_line;

    { prefix $SET, if needed }
    if (sz = 'S_') or (sy = 'SG_') then s_line := '$SET,' + s_line;

    { prefix ESUB if needed }
    sz := Copy(s_line, 1, 4);
    if (sz = 'SUB_') then s_line := 'ESUB,' + s_line;

    { omit comment at end of ENDS, }
    if (sz = 'ENDS') then s_line := 'ENDS,';

    { put semi-colon at end of line }
    s_line := Trim(s_line) + ';';

    Result := s_line;
end; { fns_tpline_format }


function TForm1.fns_link_literal_numbers(const ps_rec : string) : string;
{ updated 2006/06/11, 2004/10/11 }
{ link literal numbers into fda_var }
var
    s_record : string;
    s_alpha, s_digit : string;
    i_byte : integer;
    i_count : integer;
    i_dot : integer;
    i_long : integer;
    b_error : boolean;
    b_inquotes : boolean;
    c_quotechar : char;
    i_end : integer;
    iz : integer;
    sz : string;
    b_loop1, b_loop2 : boolean;
    b_dsetcommand : boolean;
    b_negsign : boolean;
begin
    { string literals and spaces have }
    { been removed by now }
    s_record := ps_rec + ' ';

    { do we have a DSET command }
    b_dsetcommand := false;
    if (Copy(s_record, 1, 4) = 'DSET') then b_dsetcommand := true;

    { we have all uppercase }
    s_alpha := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ_';
    s_digit := '0123456789';
    { 123456789012345678901234567890123 }
    { DIF1 00401p<<00101n:00005n+00001n }

    c_quotechar := '"';
    b_inquotes := false;
    i_byte := 5;
    b_loop1 := true;

    while b_loop1 do
    begin
        if (s_record[i_byte] = '"') or (s_record[i_byte] = '#') then
        begin
            if b_inquotes then
            begin
                if (s_record[i_byte] = c_quotechar)
                then b_inquotes := false
            end
            else
            begin
                c_quotechar := s_record[i_byte];
                b_inquotes := true;
            end;
        end;

        if not b_inquotes then
        begin
            { do we have the beginning of a literal number to expand }
            if (Pos(s_record[i_byte], s_digit) > 0)
            and (Pos(s_record[Pred(i_byte)], s_digit) = 0)
            and (Pos(s_record[Pred(i_byte)], s_alpha) = 0) then
            begin
                { is the literal number preceded by a negative sign }
                b_negsign := false;
                if (s_record[Pred(i_byte)] = '-') then
                begin
                    if b_dsetcommand then
                    begin
                        { if DSET command we must have an operator }
                        if (Pos(s_record[i_byte - 2], '+-/*\%') > 0)
                        then b_negsign := true;
                    end
                    else b_negsign := true;

                    if b_negsign then
                    begin
                        { we have negative sign so delete }
                        Dec(i_byte);
                        Delete(s_record, i_byte, 1);
                    end;
                end;

                { is the literal number preceded by a positive sign }
                if (s_record[Pred(i_byte)] = '+') then
                begin
                    if (Pos(s_record[i_byte - 2], '+-/*\%') > 0) then
                    begin
                        { we have an uneeded positive sign so delete }
                        Dec(i_byte);
                        Delete(s_record, i_byte, 1);
                    end;
                end;

                { how many digits are in the number }
                i_count := 1;
                i_dot := 0;
                i_end := i_byte;
                b_loop2 := true;

                while b_loop2 do
                begin
                    Inc(i_end);

                    if (Pos(s_record[i_end], s_digit) > 0) then Inc(i_count)
                    else if (s_record[i_end] = '.') then Inc(i_dot)
                    else b_loop2 := false;
                end;

                { get the length i_end is 1 too many }
                i_long := i_end - i_byte;

                { can the number be just a number literal }
                { only if whole and + and < 100000 }
                if (i_long < 6) and (i_dot = 0) and not b_negsign then
                begin
                    { insert a N if not ending with a letter }
                    if (Pos(s_record[i_end], s_alpha) = 0) then
                    begin
                        Insert('N', s_record, i_end);

                        { how many zeros do we need to insert }
                        i_count := 5 - i_count;
                        if (i_count > 0) then
                        Insert(StringOfChar('0', i_count), s_record, i_byte);
                    end;
                end
                else if (i_dot < 2) then
                begin
                    { we must store the number in the decimal array }
                    { get the string for the number }
                    sz := Copy(s_record, i_byte, i_long);

                    { increment the literal decimal array index }
                    Inc(fi_literal_decimals);
                    Inc(fi_dvar);

                    { change to a literal decimal and store }
                    fea_var[fi_dvar] := StrToFloat(sz);

                    { change the sign if needed }
                    if b_negsign then fea_var[fi_dvar] := -fea_var[fi_dvar];

                    { delete the number in the line }
                    Delete(s_record, i_byte, i_long);

                    { change the index to the global decimal }
                    { array index for the number }
                    sz := IntToStr(fi_dvar);

                    sz := StringOfChar('0', 5 - Length(sz)) + sz + 'G';

                    { insert back into the record }
                    Insert(sz, s_record, i_byte);
                end;
            end;
         end;

        Inc(i_byte);
        if (i_byte > Length(s_record)) then b_loop1 := false;
    end; { b_loop1 }

    Result := Trim(s_record);
end; { fns_link_literal_numbers }


function TForm1.fns_eliminate_blanks(const ps_rec : string) : string;
{ updated 2004/10/11 }
{ eliminate extra blanks and put comma after commands }
{ also make upper case except for literal strings }
var
    s_record : string;
    c_limit : char;
    i_colon : integer;
    b_instring : boolean;
    ix : integer;
begin
    s_record := Trim(ps_rec) + StringOfChar(' ', 5);

    if (s_record[5] = ' ') then s_record[5] := ',';

    { shrink and remove various blanks }
    i_colon := 0;
    ix := 1;
    c_limit := ' ';
    b_instring := false;

    { delete spaces }
    while (ix <= Length(s_record)) do
    begin
        if not b_instring and (s_record[ix] = ':') then i_colon := ix;

        if not b_instring then
        begin
            s_record[ix] := UpCase(s_record[ix]);

            if (s_record[ix] = '"') or (s_record[ix] = '#') then
            begin
                b_instring := true;
                c_limit := s_record[ix];
            end;
        end
        else
        begin
            if (s_record[ix] = c_limit) then b_instring := false;
        end;

        if not b_instring and (s_record[ix] = ' ') then
        begin
            { remove blank unless after second command in dift }
            { dift d_any=d_dot:$out 'hello' }
            if (i_colon <> (ix - 5)) then
            begin
                Delete(s_record, ix, 1);
                Dec(ix);
            end
            else s_record[ix] := ',';
        end;

        Inc(ix);
    end;

    Result := s_record;
end; { fns_eliminate_blanks }


procedure TForm1.sub_format_lines;
{ updated 2004/10/19 }
var
    i_record : integer;
    s_record : string;
    s_op : string;
    sy, sz : string;
    b_loop : boolean;
begin
    i_record := 1;
    b_loop := true;

    while b_loop and not fb_terminate do
    begin
        s_record := fsa_tpline[i_record];

        { expand the compares }
        s_op := Copy(s_record, 1, 4);

        if (s_op = 'DIF1')
        or (s_op = 'DIFT')
        or (s_op = 'DWHI')
        or (s_op = 'DBAD')
        or (s_op = '$WHI')
        or (s_op = '$IF1')
        or (s_op = '$IFT') then
        begin
            { ==,<>,<<,>>,>=,<=   }
            { 1234567890123456789 }
            { DIFT 00401n=00001n  }
            { DIFT 00401n==00001n }
            if (Pos(s_record[13], '=<>') = 0) then
                Insert(s_record[12], s_record, 13);

            sy := ',0';
            sz := Copy(s_record, 12, 2);
            if (sz = '==') then sy := ',1'
            else if (sz = '<>') then sy := ',2'
            else if (sz = '<<') then sy := ',3'
            else if (sz = '>>') then sy := ',4'
            else if (sz = '>=') then sy := ',5'
            else if (sz = '<=') then sy := ',6';
            Insert(sy, s_record, 20);
        end;

        { expand the = to =+ in DSET }
        s_op := Copy(s_record, 1, 4);
        if (s_op = 'DSET') and (s_record[12] = '=') and (s_record[13] <> '+')
            and (s_record[13] <> '-') then Insert('+', s_record, 13);

        { replace the changed line }
        fsa_tpline[i_record] := s_record;

        Inc(i_record);
        if (i_record > fi_prog_lines) then b_loop := false;
    end;
end; { sub_format_lines }


procedure TForm1.sub_prog_process;
{ updated 2003/01/02 }
{ process the program }
begin
    fb_terminate := false;

    btn_start.visible := false;

    { initialize }
    sub_initialize;

    { build the fs_tpprog array }
    sub_tpprog_build_array;

    { link the names }
    if not fb_terminate then sub_link_variable_names;

    { format some lines }
    if not fb_terminate then sub_format_lines;

    { link DWHI and DIFT }
    if not fb_terminate then sub_link_dift_sift;

    { link the subroutines }
    if not fb_terminate then sub_link_subroutines;

    { link the first parameter }
    if not fb_terminate then sub_link_first_parameter;

    { replace old commands with new }
    sub_old_to_new;

    { validate the lines }
    fs_subr_name := 'Not in a subr';
    fi_tpline := 1;

    while not fb_terminate and (fi_tpline <= fi_tpline_last) do
    begin
        sub_validate_commands;
        sub_validate_variables;
        Inc(fi_tpline);
    end;

    { sets fi_tpline and builds integer array of line commands }
    if not fb_terminate then sub_commands_to_int;

    { begin processing the gtprog }
    if not fb_terminate then sub_tpline_process;

    if fb_terminate then Application.Terminate;
end; { sub_prog_process }


procedure TForm1.sub_view_code;
{ updated 2003/12/15 }
{ view subroutines program and code }
var
    i_line : integer;
    s_line : string;
    s_somelines : string;
    i_count : integer;
    i_yesno : integer;
    iz : integer;
    sz : string;
    b_loop : boolean;
begin
    { subroutines }
    i_yesno := 999;
    i_count := 0;
    s_somelines := '';
    i_line := 1;
    b_loop := true;
    while b_loop do
    begin
        { view subroutines }
        s_line := LowerCase(fsa_tpline[i_line]);
        if (Copy(s_line, 1, 4) = 'subr') then
        begin
            s_somelines := s_somelines
            + IntToStr(i_line) + ' ' + s_line + nl;

            Inc(i_count);
            if (i_count >= 19) then
            begin
                i_yesno := fni_yesnocancel(s_somelines + 'More?');
                if (i_yesno <> 1) then b_loop := false;
                i_count := 0;
                s_somelines := '';
            end;
        end;

        Inc(i_line);
        if (i_line > fi_tpline_last) then b_loop := false;
    end;
    if (Length(s_somelines) > 0)
    then fni_yesnocancel(s_somelines + 'More?');

    sz := 'Total lines=' + IntToStr(fi_tpline_last) + nl
        + 'Enter line number?';
    sz := InputBox('Current=' + IntToStr(fi_tpline - 1), sz, '1');

    i_line := StrToIntDef(Trim(sz), 1);
    if (i_line < 1) or (i_line > fi_tpline_last) then i_line := 1;

    i_yesno := 999;
    b_loop := true;

    while b_loop do
    begin
        s_somelines := 'subroutine=' + fns_subroutine(i_line) + nl
        + fns_tplines_to_show(i_line, i_line + 19);

        i_yesno := fni_yesnocancel(s_somelines + 'More?');
        if (i_yesno <> 1) then b_loop := false;

        i_line := i_line + 20;
        if (i_line > fi_tpline_last) then b_loop := false;
    end;
end; { sub_view_code }


procedure TForm1.sub_variables;
{ updated 2007/06/16, 2004/03/04 }
{ show values of variable locations }
var
    ez : double;
    i_long : integer;
    i_yesnocancel : integer;
    sz : string;
    i_index : integer;
    i_count : integer;
    b_more : boolean;
    b_loop : boolean;
begin
    i_index := 1;
    b_more := true;

    while b_more do
    begin
        sz := 'Non-Zero Decimal Variables';

        b_loop := true;
        i_count := 0;

        while b_loop do
        begin
            ez := fea_var[i_index];

            if (ez <> 0) then
            begin
                sz := sz + nl
                + IntToStr(i_index) + '='
                + fns_from_double(ez, 1);

                Inc(i_count);
            end;

            Inc(i_index);
            if (i_count >= 25) or (i_index > fi_max_dvar)
            then b_loop := false;
        end;

        if (i_index > fi_max_dvar) then b_more := false;

        { 1=yes, 2=no, 0=cancel }
        i_yesnocancel := fni_yesnocancel(sz);
        if (i_yesnocancel <> 1) then b_more := false;
    end;

    i_index := 1;
    if (i_yesnocancel > 0) then b_more := true;

    while b_more do
    begin
        sz := 'Non-Zero Decimal Array Elements';

        b_loop := true;
        i_count := 0;

        while b_loop do
        begin
            ez := fea_array[i_index];

            if (ez <> 0) then
            begin
                sz := sz + nl
                + IntToStr(i_index) + '='
                + fns_from_double(ez, 1);

                Inc(i_count);
            end;

            Inc(i_index);
            if (i_count >= 25) or (i_index > fi_max_darray)
            then b_loop := false;
        end;

        if (i_index > fi_max_darray) then b_more := false;

        { 1=yes, 2=no, 0=cancel }
        i_yesnocancel := fni_yesnocancel(sz);
        if (i_yesnocancel <> 1) then b_more := false;
    end;

    i_index := 1;
    if (i_yesnocancel > 0) then b_more := true;

    while b_more do
    begin
        i_count := 0;
        b_loop := true;

        sz := 'Non-Empty Variable Strings, First 80 Trimmed Bytes';

        while b_loop do
        begin
            i_long := Length(fsa_var[i_index]);
            if (i_long > 0) then
            begin
                sz := sz + nl
                + IntToStr(i_index)
                + '='
                + Copy(Trim(fsa_var[i_index]), 1, 80);

                Inc(i_count);
            end;

            Inc(i_index);
            if (i_count >= 25) or (i_index > fi_max_svar)
            then b_loop := false;
        end;

        if (i_index > fi_max_svar) then b_more := false;

        { 1=yes, 2=no, 0=cancel }
        i_yesnocancel := fni_yesnocancel(sz);
        if (i_yesnocancel <> 1) then b_more := false;
    end;

    i_index := 1;
    if (i_yesnocancel > 0) then b_more := true;

    while b_more do
    begin
        i_count := 0;
        b_loop := true;

        sz := 'Non-Empty Array Strings, First 80 Trimmed Bytes';

        while b_loop do
        begin
            i_long := Length(fsa_array[i_index]);
            if (i_long > 0) then
            begin
                sz := sz + nl
                + IntToStr(i_index)
                + '='
                + Copy(Trim(fsa_array[i_index]), 1, 80);

                Inc(i_count);
            end;

            Inc(i_index);
            if (i_count >= 25) or (i_index > fi_max_sarray)
            then b_loop := false;
        end;

        if (i_index > fi_max_sarray) then b_more := false;

        { 1=yes, 2=no, 0=cancel }
        i_yesnocancel := fni_yesnocancel(sz);
        if (i_yesnocancel <> 1) then b_more := false;
    end;
end; { sub_variables }


procedure TForm1.sub_variables_info;
{ updated 2007/06/16, 2004/10/27 }
{ show values of variable locations }
var
    sz : string;
    iz : integer;
    i_bytesvar : integer;
    i_bytesarr : integer;
    i_local_d : integer;
    i_local_s : integer;
    i_total_d : integer;
    i_total_s : integer;
begin
    { add up lengths of string variables }
    i_bytesvar := 0;
    for iz := 1 to fi_max_svar do
    begin
        i_bytesvar := i_bytesvar + Length(fsa_var[iz]);
    end;

    i_bytesarr := 0;
    for iz := 1 to fi_max_sarray do
    begin
        i_bytesarr := i_bytesarr + Length(fsa_array[iz]);
    end;

    { get the total number of variables }
    i_total_d := fia_delta_d[fii_delta_d];
    i_total_s := fia_delta_s[fii_delta_s];

    { get total number of local variables }
    i_local_d := i_total_d - fi_literal_decimals - fi_global_decimals;
    i_local_s := i_total_s - fi_literal_strings - fi_global_strings;

    sz := '';
    sz := sz

        + 'Program Information' + nl
        + 'Lines=' + IntToStr(fi_prog_lines) + nl
        + 'Subroutines=' + IntToStr(fi_subroutine_ct) + nl
        + 'Comments=' + IntToStr(fi_comment_ct) + nl
        + 'max subs=' + IntToStr(fi_max_sub) + nl
        + 'max decimals=' + IntToStr(fi_max_delta_d) + nl
        + 'max strings=' + IntToStr(fi_max_delta_s) + nl + nl

        + 'Decimal Literals=' + IntToStr(fi_literal_decimals) + nl
        + 'Decimal Globals=' + IntToStr(fi_global_decimals) + nl
        + 'Decimal Locals=' + IntToStr(i_local_d) + nl
        + 'Decimal Variables=' + IntToStr(i_total_d) + nl + nl

        + 'String Literals=' + IntToStr(fi_literal_strings) + nl
        + 'String Globals=' + IntToStr(fi_global_strings) + nl
        + 'String Locals=' + IntToStr(i_local_s) + nl
        + 'String Variables=' + IntToStr(i_total_s) + nl + nl

        + 'Total String Var Length=' + IntToStr(i_bytesvar) + nl
        + 'Total String Arr Length=' + IntToStr(i_bytesarr) + nl
        + fns_subroutine(fi_tpline);

    ShowMessage(sz);
end; { sub_variables_info }


procedure TForm1.sub_get_program_name;
{ updated 2003/09/15 }
var
    s_filename : string;
    b_exists : boolean;
    sz : string;
begin
    { end if program already running }
    fb_program_loop := false;

    { choose a file for fs_tpprog_name }
    sz := 'Enter the path and filename';
    s_filename := fs_tpprog_name;
    s_filename := InputBox('Enter Teapro Program Name', sz, s_filename);
    s_filename := Trim(LowerCase(s_filename));

    label_show.Caption := '';
    fs_tpprog_name := s_filename;

    Form1.Caption := 'Teapro = ' + fs_tpprog_name;
    btn_start.Caption := 'run ' + fs_tpprog_name;
    Application.Title := fs_tpprog_name;

    btn_start.Visible := true;
    btn_start.SetFocus;
end; { sub_get_program_name }


procedure TForm1.sub_terminate;
{ updated 2006/04/28, 2000/01/01 }
{ terminate the program }
begin
    fb_program_loop := false;
    fb_terminate := true;
    Application.Terminate;
end; { sub_terminate }


procedure TForm1.menu_exitClick(Sender: TObject);
{ updated 2000/01/01 }
begin
    sub_terminate;
end; { Exit1Click }


procedure TForm1.FormActivate(Sender: TObject);
{ updated 2006/06/11, 2005/11/02, 2005/09/12, 2005/03/22, 2004/07/25 }
var
    sz : string;
begin
    Form1.Left := 0;
    Form1.Top := 0;
    label_show.caption := '';
    Randomize;

    Form1.Caption := 'Teapro9';
    Application.Title := 'Teapro9';

    fb_string_input := false;
    fs_filename_1 := '';

    fi_show_lines := 24;
    fb_show := true;
    fd_begin_time := Now;

    fs_tpprog_name := Trim(ParamStr(1));
    if (fs_tpprog_name = '') then fs_tpprog_name := 'tinytea.tea';

    if not FileExists(fs_tpprog_name) then sub_get_program_name;

    fs_tpprog_name := LowerCase(fs_tpprog_name);

    Form1.Caption := 'Teapro9 = ' + fs_tpprog_name;
    Application.Title := fs_tpprog_name;
    btn_start.Caption := 'run ' + fs_tpprog_name;
    btn_start.Visible := True;
    btn_start.SetFocus;

    Form1.Height := 478;
    Form1.Width := 640;
end; { FormActivate }


procedure TForm1.btn_startClick(Sender: TObject);
{ updated 2000/01/01 }
begin
    sub_prog_process;
end; { btn_startClick }


procedure TForm1.edit_inputKeyPress(Sender: TObject; var Key: Char);
{ updated 2000/01/01 }
begin
    if (Key = Chr(13)) then
    begin
        if fb_string_input then
        begin
            Key := Chr(0);
            fs_input := TrimRight(edit_input.text);
            edit_input.text := '';
            sub_tpline_process;
        end;
    end;
end;


procedure TForm1.About1Click(Sender: TObject);
{ updated 2000/01/01 }
begin
    sub_about;
end;


procedure TForm1.menu_ProgramCodeClick(Sender: TObject);
{ updated 2000/01/01 }
begin
    sub_view_code;
end;


procedure TForm1.menu_VariablesClick(Sender: TObject);
{ updated 2000/01/01 }
begin
    sub_variables_info;
    sub_variables;
end;


procedure TForm1.menu_debugClick(Sender: TObject);
{ updated 2002/04/30 }
{ turn debug mode on or off }
var
    iz : integer;
begin
    if fb_debug then fb_debug := false
    else
    begin
        fb_debug := true;
        for iz := 1 to 10 do fsa_debug[iz] := '';
        sub_debug;
    end;
end;


procedure TForm1.FormResize(Sender: TObject);
{ updated 2005/02/07, 2004/07/24 }
var
    i_height : integer;
    i_width : integer;
begin
    i_height := Form1.Height;
    i_width := Form1.Width;
{
    Form1.label_show.height := i_height - 78;
    Form1.label_show.width := i_width - 20;

    Form1.edit_input.top := i_height - 70;
    Form1.edit_input.width := i_width - 16;
}
    Form1.label_show.height := i_height - 78;
    Form1.label_show.width := i_width - 20;

    Form1.edit_input.top := i_height - 70;
    Form1.edit_input.width := i_width - 16;

    fi_show_lines := Trunc((i_height - 78) / 16.0);
    fi_show_lines := Round((i_height - 78) / 16.0);
    if (fi_show_lines < 1) then fi_show_lines := 1
    else if (fi_show_lines > 35) then fi_show_lines := 35;
end;


procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
{ updated 2000/01/01 }
begin
    sub_terminate;
end;


procedure TForm1.menu_openClick(Sender: TObject);
{ updated 2000/01/01 }
begin
    sub_get_program_name;
end;


procedure TForm1.Pause1Click(Sender: TObject);
{ updated 2003/12/27 }
begin
    ShowMessagePos('Ok to continue Teapro9',
        Form1.Left + 200, Form1.Top);
end;

procedure TForm1.menu_generalhelpClick(Sender: TObject);
{ updated 2000/01/01 }
begin
    sub_help_general;
end;

procedure TForm1.menu_help_commandsClick(Sender: TObject);
{ updated 2000/01/01 }
begin
    sub_help_commands
end;

procedure TForm1.menu_help_runningClick(Sender: TObject);
{ updated 2000/01/01 }
begin
    sub_help_running;
end;

end.
{ 
}