NSFW - No Such FORTH Word

It being the FORTH of May, this time around we turn to a wildly inappropriate book cover from 1983.

    < rld> <seregsarn> I just started taking notes for the fourth
           refactor of this code in the last week.
    < rld> <springogeek> A true senior developer would "refactor" the
           code by deleting it and finding a different solution entirely
    < thrig> forth refactor!
    < rld> <seregsarn> Finally a chance to get some use out of this book!

forth-atari.png

For those luckily lacking in vision, there is not much to miss here, and you are probably better off not knowing, unless you have an Atari from the early 80s—or, more likely, an emulation or remake of such—and are interested in FORTH on said system, in which case the contents, not the cover, of the book "FORTH on the Atari" may be of interest, though there are probably better books on FORTH out there.

Meanwhile, I'm still deep in the unix gravity well so haven't done much with FORTH. Instead, I was looking at "101 BASIC Computer Games" which on the plus side shows the code, has a sample session, and describes the game, but on the minus side much of the code would require unpacking to unravel the logic. There are modernized versions that may be better to study from.

    $ git clone https://github.com/coding-horror/basic-computer-games
    ...

One might also wonder how hard it would be to write a basic BASIC, minus some of the complexity the not-so-basic BASICs acquired over the years,

    RND(x)  if x>0, random number between 0 and 1
            if x=0, repeats last random number
            if x<0, begins new repeatable sequence

and one answer is that it is not too difficult, but a bunch of work to support statements and expressions and whatnot. For example, The following parser supports various mathematical operators and INT(x) and something like the Applesoft RND(x) call, though requires floating point form for all numbers in the expression.

    #!/usr/bin/env perl
    # expression.pl - parse a mathematical expression, a modification of
    # Parser::MGC::Examples::EvaluateExpression
    use 5.36.0;
    
    my %variables = ( N => 6 );
    
    package Apricot::Expression {
        use base qw[Parser::MGC];
    
        sub parse ($self) {
            my $val = $self->parse_term;
            1 while $self->any_of(
                sub { $self->expect('+'); $val += $self->parse_term; 1 },
                sub { $self->expect('-'); $val -= $self->parse_term; 1 },
                sub { 0 },
            );
            return $val;
        }
    
        sub parse_term ($self) {
            my $val = $self->parse_factor;
            1 while $self->any_of(
                sub { $self->expect('*'); $val *= $self->parse_factor; 1 },
                sub { $self->expect('/'); $val /= $self->parse_factor; 1 },
                sub { 0 },
            );
            return $val;
        }
    
        sub parse_factor ($self) {
            $self->any_of(
                sub {
                    $self->scope_of( '(', sub { $self->parse }, ')' );
                },
                sub { $self->token_float },
                sub {
                    $self->expect('INT(');
                    int $self->scope_of( undef, sub { $self->parse }, ')' );
                },
                sub {
                    state $last = rand();
                    $self->expect('RND(');
                    my $x = $self->scope_of( undef, sub { $self->parse }, ')' );
                    if ( $x > 0 ) {
                        return $last = rand;
                    } elsif ( $x < 0 ) {
                        srand unpack J => pack F => $x;
                        return $last = rand;
                    } else {
                        return $last;
                    }
                },
                sub {
                    my $var = $self->expect(qr/[A-Z][A-Z0-9]?/);
                    $variables{$var} // $self->die("no such variable '$var'");
                }
            );
        }
    }
    
    say Apricot::Expression->new->from_string("@ARGV");

expression.pl

    $ perl expression.pl '2.0 + 3.0 * 4.0'
    14
    $ perl expression.pl '(2.0+3.0)*4.0'
    20
    $ perl expression.pl 'INT(3.0+RND(N)*6.0+RND(N)*6.0+RND(N)*6.0)'
    11
    $ perl expression.pl 'RND(-1.0)'
    0.17082803610629
    $ perl expression.pl 'RND(-1.0)'
    0.17082803610629
    $ perl expression.pl 'N+M'
    no such variable 'M' on line 1 at:
    N+M
       ^

This might get pretty complicated compared to a FORTH, as you still need to support line numbers, statements, GOTO, etc. On the other hand, usually one can find a parser library (or a Bison to shave) or that someone has already written a BASIC, possibly one that compiles down to assembly.

P.S. The wacky "unpack J => pack F =>" thing is a kluge aimed at obtaining a hopefully unique integer seed for srand from what probably is a floating point value. This is due to, say, 3.1 and 3.2 (probably) resulting in the same seed value:

    $ perl -E 'srand 3.1; say rand; srand 3.2; say rand'
    0.783234962103055
    0.783234962103055

while instead packing the what is probably a floating point value into a object then unpacking it as an integer should obtain different seed values for 3.1 versus 3.2:

    $ perl -E 'sub r {srand unpack J => pack F => $_[0];say rand}' \
      -E 'r $_ for 3.1, 3.2'
    0.944988497839407
    0.719148959572525

It may also be interesting to observe what is going on with the bits; the following assumes a 64-bit values:

    $ perl -e 'printf "%064b\n", unpack J => pack F => 3.1415'
    0100000000001001001000011100101011000000100000110001001001101111
    $ perl -e 'printf "%064b\n", unpack J => pack F => -3.1415'
    1100000000001001001000011100101011000000100000110001001001101111
    $ perl -e 'printf "%064b\n", unpack J => pack F => -3'
    1100000000001000000000000000000000000000000000000000000000000000
    $ perl -e 'printf "%064b\n", unpack J => pack F => 3'
    0100000000001000000000000000000000000000000000000000000000000000

This is the same thing as you can do in C via something like:

    $ perl -e 'printf "%d\n", unpack J => pack F => 3.1415'
    4614256447914709615
    $ cfu 'double d = 3.1415; long *x = (long *)&d; printf("%ld\n", *x)'
    4614256447914709615

On the other hand, the Applesoft RND(x) may not be a good interface to copy, as it is probably too complicated and overloaded with different behaviors.