raw
ffa_ch4_ffacalc.kv      1 ------------------------------------------------------------------------------
ffa_ch4_ffacalc.kv      2 ------------------------------------------------------------------------------
ffa_ch4_ffacalc.kv      3 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'.               --
ffa_ch4_ffacalc.kv      4 --                                                                          --
ffa_ch4_ffacalc.kv      5 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org )                      --
ffa_ch4_ffacalc.kv      6 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html     --
ffa_ch4_ffacalc.kv      7 --                                                                          --
ffa_ch4_ffacalc.kv      8 -- You do not have, nor can you ever acquire the right to use, copy or      --
ffa_ch4_ffacalc.kv      9 -- distribute this software ; Should you use this software for any purpose, --
ffa_ch4_ffacalc.kv     10 -- or copy and distribute it to anyone or in any manner, you are breaking   --
ffa_ch4_ffacalc.kv     11 -- the laws of whatever soi-disant jurisdiction, and you promise to         --
ffa_ch4_ffacalc.kv     12 -- continue doing so for the indefinite future. In any case, please         --
ffa_ch4_ffacalc.kv     13 -- always : read and understand any software ; verify any PGP signatures    --
ffa_ch4_ffacalc.kv     14 -- that you use - for any purpose.                                          --
ffa_ch4_ffacalc.kv     15 --                                                                          --
ffa_ch4_ffacalc.kv     16 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm .     --
ffa_ch4_ffacalc.kv     17 ------------------------------------------------------------------------------
ffa_ch4_ffacalc.kv     18 ------------------------------------------------------------------------------
ffa_ch4_ffacalc.kv     19 
ffa_ch4_ffacalc.kv     20 -- Basics
ffa_ch8_randomism.kv   21 with OS;       use OS;
ffa_ch8_randomism.kv   22 with CmdLine;  use CmdLine;
ffa_ch4_ffacalc.kv     23 
ffa_ch4_ffacalc.kv     24 -- FFA
ffa_ch11_tuning_a...   25 with FFA;      use FFA;
ffa_ch4_ffacalc.kv     26 
ffa_ch11_tuning_a...   27 -- For the intrinsic equality operator on Words
ffa_ch11_tuning_a...   28 use type FFA.Word;
ffa_ch4_ffacalc.kv     29 
ffa_ch8_randomism.kv   30 -- For RNG:
ffa_ch8_randomism.kv   31 with FFA_RNG;  use FFA_RNG;
ffa_ch8_randomism.kv   32 
ffa_ch8_randomism.kv   33 
ffa_ch4_ffacalc.kv     34 procedure FFA_Calc is
ffa_ch4_ffacalc.kv     35    
ffa_ch8_randomism.kv   36    Width  : Positive;   -- Desired FFA Width
ffa_ch8_randomism.kv   37    Height : Positive;   -- Desired Height of Stack
ffa_ch8_randomism.kv   38    RNG    : RNG_Device; -- The active RNG device.
ffa_ch4_ffacalc.kv     39    
ffa_ch4_ffacalc.kv     40 begin
ffa_ch8_randomism.kv   41    if Arg_Count < 3 or Arg_Count > 4 then
ffa_ch8_randomism.kv   42       Eggog("Usage: ./ffa_calc WIDTH HEIGHT [/dev/rng]");
ffa_ch4_ffacalc.kv     43    end if;
ffa_ch4_ffacalc.kv     44    
ffa_ch4_ffacalc.kv     45    declare
ffa_ch4_ffacalc.kv     46       Arg1 : CmdLineArg;
ffa_ch4_ffacalc.kv     47       Arg2 : CmdLineArg;
ffa_ch4_ffacalc.kv     48    begin
ffa_ch4_ffacalc.kv     49       -- Get commandline args:
ffa_ch4_ffacalc.kv     50       Get_Argument(1, Arg1); -- First arg
ffa_ch4_ffacalc.kv     51       Get_Argument(2, Arg2); -- Second arg
ffa_ch4_ffacalc.kv     52       
ffa_ch8_randomism.kv   53       if Arg_Count = 4 then
ffa_ch8_randomism.kv   54          -- RNG was specified:
ffa_ch8_randomism.kv   55          declare
ffa_ch8_randomism.kv   56             Arg3 : CmdLineArg;
ffa_ch8_randomism.kv   57          begin
ffa_ch8_randomism.kv   58             Get_Argument(3, Arg3); -- Third arg (optional)
ffa_ch8_randomism.kv   59             
ffa_ch8_randomism.kv   60             -- Ada.Sequential_IO chokes on paths with trailing whitespace!
ffa_ch8_randomism.kv   61             -- So we have to give it a trimmed path. But we can't use
ffa_ch8_randomism.kv   62             -- Ada.Strings.Fixed.Trim, because it suffers from
ffa_ch8_randomism.kv   63             -- SecondaryStackism-syphilis. Instead we are stuck doing this:
ffa_ch8_randomism.kv   64             Init_RNG(RNG, Arg3(Arg3'First .. Len_Arg(3)));
ffa_ch8_randomism.kv   65          end;
ffa_ch8_randomism.kv   66       else
ffa_ch8_randomism.kv   67          -- RNG was NOT specified:
ffa_ch8_randomism.kv   68          Init_RNG(RNG); -- Use the machine default then
ffa_ch8_randomism.kv   69       end if;
ffa_ch8_randomism.kv   70       
ffa_ch4_ffacalc.kv     71       -- Parse into Positives:
ffa_ch4_ffacalc.kv     72       Width  := Positive'Value(Arg1);
ffa_ch4_ffacalc.kv     73       Height := Positive'Value(Arg2);
ffa_ch4_ffacalc.kv     74    exception
ffa_ch4_ffacalc.kv     75       when others =>
ffa_ch4_ffacalc.kv     76          Eggog("Invalid arguments!");
ffa_ch4_ffacalc.kv     77    end;
ffa_ch4_ffacalc.kv     78    
ffa_ch4_ffacalc.kv     79    -- Test if proposed Width is permissible:
ffa_ch11_tuning_a...   80    if not FFA_FZ_Valid_Bitness_P(Width) then
ffa_ch11_tuning_a...   81       Eggog("Invalid Width: " & FFA_Validity_Rule_Doc);
ffa_ch4_ffacalc.kv     82    end if;
ffa_ch4_ffacalc.kv     83    
ffa_ch4_ffacalc.kv     84    -- The Calculator itself:
ffa_ch4_ffacalc.kv     85    declare
ffa_ch4_ffacalc.kv     86       
ffa_ch4_ffacalc.kv     87       -- The number of Words required to make a FZ of the given Bitness.
ffa_ch4_ffacalc.kv     88       Wordness : Indices := Indices(Width / Bitness);
ffa_ch4_ffacalc.kv     89       
ffa_ch4_ffacalc.kv     90       --------------------------------------------------------
ffa_ch4_ffacalc.kv     91       -- State --
ffa_ch4_ffacalc.kv     92       --------------------------------------------------------
ffa_ch4_ffacalc.kv     93       -- The Stack:
ffa_ch4_ffacalc.kv     94       subtype Stack_Positions is Natural range 0 .. Height;
ffa_ch4_ffacalc.kv     95       type Stacks is array(Stack_Positions range <>) of FZ(1 .. Wordness);
ffa_ch4_ffacalc.kv     96       Stack      : Stacks(Stack_Positions'Range);
ffa_ch4_ffacalc.kv     97       
ffa_ch4_ffacalc.kv     98       -- Stack Pointer:
ffa_ch4_ffacalc.kv     99       SP         : Stack_Positions := Stack_Positions'First;
ffa_ch4_ffacalc.kv    100       
ffa_ch4_ffacalc.kv    101       -- Carry/Borrow Flag:
ffa_ch4_ffacalc.kv    102       Flag       : WBool   := 0;
ffa_ch4_ffacalc.kv    103       
ffa_ch4_ffacalc.kv    104       -- Odometer:
ffa_ch4_ffacalc.kv    105       Pos        : Natural := 0;
ffa_ch4_ffacalc.kv    106       
ffa_ch4_ffacalc.kv    107       -- The current levels of the three types of nestedness:
ffa_ch4_ffacalc.kv    108       QuoteLevel : Natural := 0;
ffa_ch4_ffacalc.kv    109       CommLevel  : Natural := 0;
ffa_ch4_ffacalc.kv    110       CondLevel  : Natural := 0;
ffa_ch4_ffacalc.kv    111       --------------------------------------------------------
ffa_ch4_ffacalc.kv    112       
ffa_ch4_ffacalc.kv    113       
ffa_ch4_ffacalc.kv    114       -- Clear the stack and set SP to bottom.
ffa_ch4_ffacalc.kv    115       procedure Zap is
ffa_ch4_ffacalc.kv    116       begin
ffa_ch4_ffacalc.kv    117          -- Clear the stack
ffa_ch4_ffacalc.kv    118          for i in Stack'Range loop
ffa_ch11_tuning_a...  119             FFA_FZ_Clear(Stack(i));
ffa_ch4_ffacalc.kv    120          end loop;
ffa_ch4_ffacalc.kv    121          -- Set SP to bottom
ffa_ch4_ffacalc.kv    122          SP   := Stack_Positions'First;
ffa_ch4_ffacalc.kv    123          -- Clear Overflow flag
ffa_ch4_ffacalc.kv    124          Flag := 0;
ffa_ch4_ffacalc.kv    125       end Zap;
ffa_ch4_ffacalc.kv    126       
ffa_ch4_ffacalc.kv    127       
ffa_ch4_ffacalc.kv    128       -- Report a fatal error condition at the current symbol
ffa_ch4_ffacalc.kv    129       procedure E(S : in String) is
ffa_ch4_ffacalc.kv    130       begin
ffa_ch4_ffacalc.kv    131          Eggog("Pos:" & Natural'Image(Pos) & ": " & S);
ffa_ch4_ffacalc.kv    132       end E;
ffa_ch4_ffacalc.kv    133       
ffa_ch4_ffacalc.kv    134       
ffa_ch4_ffacalc.kv    135       -- Move SP up
ffa_ch4_ffacalc.kv    136       procedure Push is
ffa_ch4_ffacalc.kv    137       begin
ffa_ch4_ffacalc.kv    138          if SP = Stack_Positions'Last then
ffa_ch4_ffacalc.kv    139             E("Stack Overflow!");
ffa_ch4_ffacalc.kv    140          else
ffa_ch4_ffacalc.kv    141             SP := SP + 1;
ffa_ch4_ffacalc.kv    142          end if;
ffa_ch4_ffacalc.kv    143       end Push;
ffa_ch4_ffacalc.kv    144       
ffa_ch4_ffacalc.kv    145       
ffa_ch4_ffacalc.kv    146       -- Discard the top of the stack
ffa_ch4_ffacalc.kv    147       procedure Drop is
ffa_ch4_ffacalc.kv    148       begin
ffa_ch11_tuning_a...  149          FFA_FZ_Clear(Stack(SP));
ffa_ch4_ffacalc.kv    150          SP := SP - 1;
ffa_ch4_ffacalc.kv    151       end Drop;
ffa_ch4_ffacalc.kv    152       
ffa_ch4_ffacalc.kv    153       
ffa_ch4_ffacalc.kv    154       -- Check if stack has the necessary N items
ffa_ch4_ffacalc.kv    155       procedure Want(N : in Positive) is
ffa_ch4_ffacalc.kv    156       begin
ffa_ch4_ffacalc.kv    157          if SP < N then
ffa_ch4_ffacalc.kv    158             E("Stack Underflow!");
ffa_ch4_ffacalc.kv    159          end if;
ffa_ch4_ffacalc.kv    160       end Want;
ffa_ch4_ffacalc.kv    161       
ffa_ch4_ffacalc.kv    162       
ffa_ch5_egypt.kv      163       -- Ensure that a divisor is not zero
ffa_ch5_egypt.kv      164       procedure MustNotZero(D : in FZ) is
ffa_ch5_egypt.kv      165       begin
ffa_ch11_tuning_a...  166          if FFA_FZ_ZeroP(D) = 1 then
ffa_ch5_egypt.kv      167             E("Division by Zero!");
ffa_ch5_egypt.kv      168          end if;
ffa_ch5_egypt.kv      169       end MustNotZero;
ffa_ch5_egypt.kv      170       
ffa_ch5_egypt.kv      171       
ffa_ch4_ffacalc.kv    172       -- Slide a new hex digit into the FZ on top of stack
ffa_ch11_tuning_a...  173       procedure Ins_Hex_Digit(Digit : in Nibble) is
ffa_ch11_tuning_a...  174          Overflow : WBool := 0;
ffa_ch4_ffacalc.kv    175       begin
ffa_ch11_tuning_a...  176          
ffa_ch11_tuning_a...  177          -- Insert the given nibble, and detect any overflow:
ffa_ch11_tuning_a...  178          FFA_FZ_Insert_Bottom_Nibble(N        => Stack(SP),
ffa_ch11_tuning_a...  179                                      D        => Digit,
ffa_ch11_tuning_a...  180                                      Overflow => Overflow);
ffa_ch4_ffacalc.kv    181          
ffa_ch4_ffacalc.kv    182          -- Constants which exceed the Width are forbidden:
ffa_ch11_tuning_a...  183          if Overflow = 1 then
ffa_ch4_ffacalc.kv    184             E("Constant Exceeds Bitness!");
ffa_ch4_ffacalc.kv    185          end if;
ffa_ch4_ffacalc.kv    186          
ffa_ch4_ffacalc.kv    187       end;
ffa_ch4_ffacalc.kv    188       
ffa_ch4_ffacalc.kv    189       
ffa_ch11_tuning_a...  190       -- Emit an ASCII representation of N to the terminal
ffa_ch11_tuning_a...  191       procedure Print_FZ(N : in FZ) is
ffa_ch11_tuning_a...  192          S : String(1 .. FFA_FZ_ASCII_Length(N)); -- Mandatorily, exact size
ffa_ch11_tuning_a...  193       begin
ffa_ch11_tuning_a...  194          FFA_FZ_To_Hex_String(N, S); -- Convert N to ASCII hex
ffa_ch11_tuning_a...  195          Write_String(S);            -- Print the result to stdout
ffa_ch11_tuning_a...  196          Write_Newline;              -- Print newline, for clarity.
ffa_ch11_tuning_a...  197       end Print_FZ;
ffa_ch11_tuning_a...  198       
ffa_ch11_tuning_a...  199       
ffa_ch4_ffacalc.kv    200       -- Execute a Normal Op
ffa_ch4_ffacalc.kv    201       procedure Op_Normal(C : in Character) is
ffa_ch4_ffacalc.kv    202          
ffa_ch4_ffacalc.kv    203          -- Over/underflow output from certain ops
ffa_ch4_ffacalc.kv    204          F : Word;
ffa_ch4_ffacalc.kv    205          
ffa_ch4_ffacalc.kv    206       begin
ffa_ch4_ffacalc.kv    207          
ffa_ch4_ffacalc.kv    208          case C is
ffa_ch4_ffacalc.kv    209             
ffa_ch4_ffacalc.kv    210             --------------
ffa_ch4_ffacalc.kv    211             -- Stickies --
ffa_ch4_ffacalc.kv    212             --------------
ffa_ch4_ffacalc.kv    213             -- Enter Commented
ffa_ch4_ffacalc.kv    214             when '(' =>
ffa_ch4_ffacalc.kv    215                CommLevel := 1;
ffa_ch4_ffacalc.kv    216                
ffa_ch4_ffacalc.kv    217                -- Exit Commented (but we aren't in it!)
ffa_ch4_ffacalc.kv    218             when ')' =>
ffa_ch4_ffacalc.kv    219                E("Mismatched close-comment parenthesis !");
ffa_ch4_ffacalc.kv    220                
ffa_ch4_ffacalc.kv    221                -- Enter Quoted
ffa_ch4_ffacalc.kv    222             when '[' =>
ffa_ch4_ffacalc.kv    223                QuoteLevel := 1;
ffa_ch4_ffacalc.kv    224                
ffa_ch4_ffacalc.kv    225                -- Exit Quoted (but we aren't in it!)
ffa_ch4_ffacalc.kv    226             when ']' =>
ffa_ch4_ffacalc.kv    227                E("Mismatched close-quote bracket !");
ffa_ch4_ffacalc.kv    228                
ffa_ch4_ffacalc.kv    229                -- Enter a ~taken~ Conditional branch:
ffa_ch4_ffacalc.kv    230             when '{' =>
ffa_ch4_ffacalc.kv    231                Want(1);
ffa_ch11_tuning_a...  232                if FFA_FZ_ZeroP(Stack(SP)) = 1 then
ffa_ch4_ffacalc.kv    233                   CondLevel := 1;
ffa_ch4_ffacalc.kv    234                end if;
ffa_ch4_ffacalc.kv    235                Drop;
ffa_ch4_ffacalc.kv    236                
ffa_ch4_ffacalc.kv    237                -- Exit from a ~non-taken~ Conditional branch:
ffa_ch4_ffacalc.kv    238                -- ... we push a 0, to suppress the 'else' clause
ffa_ch4_ffacalc.kv    239             when '}' =>
ffa_ch4_ffacalc.kv    240                Push;
ffa_ch11_tuning_a...  241                FFA_WBool_To_FZ(0, Stack(SP));
ffa_ch4_ffacalc.kv    242                
ffa_ch4_ffacalc.kv    243                ----------------
ffa_ch4_ffacalc.kv    244                -- Immediates --
ffa_ch4_ffacalc.kv    245                ----------------
ffa_ch4_ffacalc.kv    246                
ffa_ch4_ffacalc.kv    247                -- These operate on the FZ ~currently~ at top of the stack;
ffa_ch4_ffacalc.kv    248                -- and this means that the stack may NOT be empty.
ffa_ch4_ffacalc.kv    249                
ffa_ch4_ffacalc.kv    250             when '0' .. '9' =>
ffa_ch4_ffacalc.kv    251                Want(1);
ffa_ch11_tuning_a...  252                Ins_Hex_Digit(Character'Pos(C) - Character'Pos('0'));
ffa_ch4_ffacalc.kv    253                
ffa_ch4_ffacalc.kv    254             when 'A' .. 'F' =>
ffa_ch4_ffacalc.kv    255                Want(1);
ffa_ch11_tuning_a...  256                Ins_Hex_Digit(10 + Character'Pos(C) - Character'Pos('A'));
ffa_ch4_ffacalc.kv    257                
ffa_ch4_ffacalc.kv    258             when 'a' .. 'f' =>
ffa_ch4_ffacalc.kv    259                Want(1);
ffa_ch11_tuning_a...  260                Ins_Hex_Digit(10 + Character'Pos(C) - Character'Pos('a'));
ffa_ch4_ffacalc.kv    261                
ffa_ch4_ffacalc.kv    262                ------------------
ffa_ch4_ffacalc.kv    263                -- Stack Motion --
ffa_ch4_ffacalc.kv    264                ------------------
ffa_ch4_ffacalc.kv    265                
ffa_ch4_ffacalc.kv    266                -- Push a 0 onto the stack
ffa_ch4_ffacalc.kv    267             when '.' =>
ffa_ch4_ffacalc.kv    268                Push;
ffa_ch11_tuning_a...  269                FFA_FZ_Clear(Stack(SP));
ffa_ch4_ffacalc.kv    270                
ffa_ch4_ffacalc.kv    271                -- Dup
ffa_ch4_ffacalc.kv    272             when '"' =>
ffa_ch4_ffacalc.kv    273                Want(1);
ffa_ch4_ffacalc.kv    274                Push;
ffa_ch4_ffacalc.kv    275                Stack(SP) := Stack(SP - 1);
ffa_ch4_ffacalc.kv    276                
ffa_ch4_ffacalc.kv    277                -- Drop
ffa_ch4_ffacalc.kv    278             when '_' =>
ffa_ch4_ffacalc.kv    279                Want(1);
ffa_ch4_ffacalc.kv    280                Drop;
ffa_ch4_ffacalc.kv    281                
ffa_ch4_ffacalc.kv    282                -- Swap
ffa_ch4_ffacalc.kv    283             when ''' =>
ffa_ch4_ffacalc.kv    284                Want(2);
ffa_ch11_tuning_a...  285                FFA_FZ_Swap(Stack(SP), Stack(SP - 1));
ffa_ch4_ffacalc.kv    286                
ffa_ch4_ffacalc.kv    287                -- Over
ffa_ch4_ffacalc.kv    288             when '`' =>
ffa_ch4_ffacalc.kv    289                Want(2);
ffa_ch4_ffacalc.kv    290                Push;
ffa_ch4_ffacalc.kv    291                Stack(SP) := Stack(SP - 2);
ffa_ch4_ffacalc.kv    292                
ffa_ch4_ffacalc.kv    293                ----------------
ffa_ch4_ffacalc.kv    294                -- Predicates --
ffa_ch4_ffacalc.kv    295                ----------------
ffa_ch4_ffacalc.kv    296                
ffa_ch4_ffacalc.kv    297                -- Equality
ffa_ch4_ffacalc.kv    298             when '=' =>
ffa_ch4_ffacalc.kv    299                Want(2);
ffa_ch11_tuning_a...  300                FFA_WBool_To_FZ(FFA_FZ_EqP(X => Stack(SP),
ffa_ch11_tuning_a...  301                                           Y => Stack(SP - 1)),
ffa_ch11_tuning_a...  302                                Stack(SP - 1));
ffa_ch4_ffacalc.kv    303                Drop;
ffa_ch4_ffacalc.kv    304                
ffa_ch4_ffacalc.kv    305                -- Less-Than
ffa_ch4_ffacalc.kv    306             when '<' =>
ffa_ch4_ffacalc.kv    307                Want(2);
ffa_ch11_tuning_a...  308                FFA_WBool_To_FZ(FFA_FZ_LessThanP(X => Stack(SP - 1),
ffa_ch11_tuning_a...  309                                                 Y => Stack(SP)),
ffa_ch11_tuning_a...  310                                Stack(SP - 1));
ffa_ch4_ffacalc.kv    311                Drop;
ffa_ch4_ffacalc.kv    312                
ffa_ch4_ffacalc.kv    313                -- Greater-Than
ffa_ch4_ffacalc.kv    314             when '>' =>
ffa_ch4_ffacalc.kv    315                Want(2);
ffa_ch11_tuning_a...  316                FFA_WBool_To_FZ(FFA_FZ_GreaterThanP(X => Stack(SP - 1),
ffa_ch11_tuning_a...  317                                                    Y => Stack(SP)),
ffa_ch11_tuning_a...  318                                Stack(SP - 1));
ffa_ch4_ffacalc.kv    319                Drop;
ffa_ch4_ffacalc.kv    320                
ffa_ch4_ffacalc.kv    321                ----------------
ffa_ch4_ffacalc.kv    322                -- Arithmetic --
ffa_ch4_ffacalc.kv    323                ----------------
ffa_ch4_ffacalc.kv    324                
ffa_ch4_ffacalc.kv    325                -- Subtract
ffa_ch4_ffacalc.kv    326             when '-' =>
ffa_ch4_ffacalc.kv    327                Want(2);
ffa_ch11_tuning_a...  328                FFA_FZ_Subtract(X          => Stack(SP - 1),
ffa_ch11_tuning_a...  329                                Y          => Stack(SP),
ffa_ch11_tuning_a...  330                                Difference => Stack(SP - 1),
ffa_ch11_tuning_a...  331                                Underflow  => F);
ffa_ch11_tuning_a...  332                Flag := FFA_Word_NZeroP(F);
ffa_ch4_ffacalc.kv    333                Drop;
ffa_ch4_ffacalc.kv    334                
ffa_ch4_ffacalc.kv    335                -- Add
ffa_ch4_ffacalc.kv    336             when '+' =>
ffa_ch4_ffacalc.kv    337                Want(2);
ffa_ch11_tuning_a...  338                FFA_FZ_Add(X        => Stack(SP - 1),
ffa_ch11_tuning_a...  339                           Y        => Stack(SP),
ffa_ch11_tuning_a...  340                           Sum      => Stack(SP - 1),
ffa_ch11_tuning_a...  341                           Overflow => F);
ffa_ch11_tuning_a...  342                Flag := FFA_Word_NZeroP(F);
ffa_ch4_ffacalc.kv    343                Drop;
ffa_ch4_ffacalc.kv    344                
ffa_ch5_egypt.kv      345                -- Divide and give Quotient and Remainder
ffa_ch5_egypt.kv      346             when '\' =>
ffa_ch5_egypt.kv      347                Want(2);
ffa_ch5_egypt.kv      348                MustNotZero(Stack(SP));
ffa_ch11_tuning_a...  349                FFA_FZ_IDiv(Dividend  => Stack(SP - 1),
ffa_ch11_tuning_a...  350                            Divisor   => Stack(SP),
ffa_ch11_tuning_a...  351                            Quotient  => Stack(SP - 1),
ffa_ch11_tuning_a...  352                            Remainder => Stack(SP));
ffa_ch5_egypt.kv      353                
ffa_ch5_egypt.kv      354                -- Divide and give Quotient only
ffa_ch5_egypt.kv      355             when '/' =>
ffa_ch5_egypt.kv      356                Want(2);
ffa_ch5_egypt.kv      357                MustNotZero(Stack(SP));
ffa_ch11_tuning_a...  358                FFA_FZ_Div(Dividend  => Stack(SP - 1),
ffa_ch11_tuning_a...  359                           Divisor   => Stack(SP),
ffa_ch11_tuning_a...  360                           Quotient  => Stack(SP - 1));
ffa_ch5_egypt.kv      361                Drop;
ffa_ch5_egypt.kv      362                
ffa_ch5_egypt.kv      363                -- Divide and give Remainder only
ffa_ch5_egypt.kv      364             when '%' =>
ffa_ch5_egypt.kv      365                Want(2);
ffa_ch5_egypt.kv      366                MustNotZero(Stack(SP));
ffa_ch11_tuning_a...  367                FFA_FZ_Mod(Dividend  => Stack(SP - 1),
ffa_ch11_tuning_a...  368                           Divisor   => Stack(SP),
ffa_ch11_tuning_a...  369                           Remainder => Stack(SP - 1));
ffa_ch5_egypt.kv      370                Drop;
ffa_ch5_egypt.kv      371                
ffa_ch5_egypt.kv      372                -- Multiply, give bottom and top halves
ffa_ch5_egypt.kv      373             when '*' =>
ffa_ch5_egypt.kv      374                Want(2);
ffa_ch11_tuning_a...  375                FFA_FZ_Multiply(X     => Stack(SP - 1),
ffa_ch11_tuning_a...  376                                Y     => Stack(SP),
ffa_ch11_tuning_a...  377                                XY_Lo => Stack(SP - 1),
ffa_ch11_tuning_a...  378                                XY_Hi => Stack(SP));
ffa_ch5_egypt.kv      379                
ffa_ch6_simplest_...  380                -- Modular Multiplication
ffa_ch6_simplest_...  381             when 'M' =>
ffa_ch6_simplest_...  382                Want(3);
ffa_ch6_simplest_...  383                MustNotZero(Stack(SP));
ffa_ch11_tuning_a...  384                FFA_FZ_Modular_Multiply(X       => Stack(SP - 2),
ffa_ch11_tuning_a...  385                                        Y       => Stack(SP - 1),
ffa_ch11_tuning_a...  386                                        Modulus => Stack(SP),
ffa_ch11_tuning_a...  387                                        Product => Stack(SP - 2));
ffa_ch6_simplest_...  388                Drop;
ffa_ch6_simplest_...  389                Drop;
ffa_ch6_simplest_...  390                
ffa_ch6_simplest_...  391                -- Modular Exponentiation
ffa_ch6_simplest_...  392             when 'X' =>
ffa_ch6_simplest_...  393                Want(3);
ffa_ch6_simplest_...  394                MustNotZero(Stack(SP));
ffa_ch11_tuning_a...  395                FFA_FZ_Modular_Exponentiate(Base     => Stack(SP - 2),
ffa_ch11_tuning_a...  396                                            Exponent => Stack(SP - 1),
ffa_ch11_tuning_a...  397                                            Modulus  => Stack(SP),
ffa_ch11_tuning_a...  398                                            Result   => Stack(SP - 2));
ffa_ch6_simplest_...  399                Drop;
ffa_ch6_simplest_...  400                Drop;
ffa_ch6_simplest_...  401                
ffa_ch4_ffacalc.kv    402                -----------------
ffa_ch4_ffacalc.kv    403                -- Bitwise Ops --
ffa_ch4_ffacalc.kv    404                -----------------
ffa_ch4_ffacalc.kv    405                
ffa_ch4_ffacalc.kv    406                -- Bitwise-And
ffa_ch4_ffacalc.kv    407             when '&' =>
ffa_ch4_ffacalc.kv    408                Want(2);
ffa_ch11_tuning_a...  409                FFA_FZ_And(X      => Stack(SP - 1),
ffa_ch11_tuning_a...  410                           Y      => Stack(SP),
ffa_ch11_tuning_a...  411                           Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv    412                Drop;
ffa_ch4_ffacalc.kv    413                
ffa_ch4_ffacalc.kv    414                -- Bitwise-Or
ffa_ch4_ffacalc.kv    415             when '|' =>
ffa_ch4_ffacalc.kv    416                Want(2);
ffa_ch11_tuning_a...  417                FFA_FZ_Or(X      => Stack(SP - 1),
ffa_ch11_tuning_a...  418                          Y      => Stack(SP),
ffa_ch11_tuning_a...  419                          Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv    420                Drop;
ffa_ch4_ffacalc.kv    421                
ffa_ch4_ffacalc.kv    422                -- Bitwise-Xor
ffa_ch4_ffacalc.kv    423             when '^' =>
ffa_ch4_ffacalc.kv    424                Want(2);
ffa_ch11_tuning_a...  425                FFA_FZ_Xor(X      => Stack(SP - 1),
ffa_ch11_tuning_a...  426                           Y      => Stack(SP),
ffa_ch11_tuning_a...  427                           Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv    428                Drop;
ffa_ch4_ffacalc.kv    429                
ffa_ch4_ffacalc.kv    430                -- Bitwise-Not (1s-Complement)
ffa_ch4_ffacalc.kv    431             when '~' =>
ffa_ch4_ffacalc.kv    432                Want(1);
ffa_ch11_tuning_a...  433                FFA_FZ_Not(Stack(SP), Stack(SP));
ffa_ch4_ffacalc.kv    434                
ffa_ch4_ffacalc.kv    435                -----------
ffa_ch4_ffacalc.kv    436                -- Other --
ffa_ch4_ffacalc.kv    437                -----------
ffa_ch4_ffacalc.kv    438                
ffa_ch8_randomism.kv  439                -- Push a FZ of RNGolade onto the stack
ffa_ch8_randomism.kv  440             when '?' =>
ffa_ch8_randomism.kv  441                Push;
ffa_ch11_tuning_a...  442                FFA_FZ_Clear(Stack(SP));
ffa_ch8_randomism.kv  443                FZ_Random(RNG, Stack(SP));
ffa_ch8_randomism.kv  444                
ffa_ch4_ffacalc.kv    445                -- mUx
ffa_ch4_ffacalc.kv    446             when 'U' =>
ffa_ch4_ffacalc.kv    447                Want(3);
ffa_ch11_tuning_a...  448                FFA_FZ_Mux(X      => Stack(SP - 2),
ffa_ch11_tuning_a...  449                           Y      => Stack(SP - 1),
ffa_ch11_tuning_a...  450                           Result => Stack(SP - 2),
ffa_ch11_tuning_a...  451                           Sel    => FFA_FZ_NZeroP(Stack(SP)));
ffa_ch4_ffacalc.kv    452                Drop;
ffa_ch4_ffacalc.kv    453                Drop;
ffa_ch4_ffacalc.kv    454                
ffa_ch4_ffacalc.kv    455                -- Put the Overflow flag on the stack
ffa_ch4_ffacalc.kv    456             when 'O' =>
ffa_ch4_ffacalc.kv    457                Push;
ffa_ch11_tuning_a...  458                FFA_WBool_To_FZ(Flag, Stack(SP));
ffa_ch4_ffacalc.kv    459                
ffa_ch4_ffacalc.kv    460                -- Print the FZ on the top of the stack
ffa_ch4_ffacalc.kv    461             when '#' =>
ffa_ch4_ffacalc.kv    462                Want(1);
ffa_ch11_tuning_a...  463                Print_FZ(Stack(SP));
ffa_ch4_ffacalc.kv    464                Drop;
ffa_ch4_ffacalc.kv    465                
ffa_ch4_ffacalc.kv    466                -- Zap (reset)
ffa_ch4_ffacalc.kv    467             when 'Z' =>
ffa_ch4_ffacalc.kv    468                Zap;
ffa_ch4_ffacalc.kv    469                
ffa_ch4_ffacalc.kv    470                -- Quit with Stack Trace
ffa_ch4_ffacalc.kv    471             when 'Q' =>
ffa_ch4_ffacalc.kv    472                for I in reverse Stack'First + 1 .. SP loop
ffa_ch11_tuning_a...  473                   Print_FZ(Stack(I));
ffa_ch4_ffacalc.kv    474                end loop;
ffa_ch4_ffacalc.kv    475                Quit(0);
ffa_ch4_ffacalc.kv    476                
ffa_ch12_karatsub...  477                ---------------------------------------------------------
ffa_ch12_karatsub...  478                -- Ch. 12B:
ffa_ch12_karatsub...  479                -- Square, give bottom and top halves
ffa_ch12_karatsub...  480             when 'S' =>
ffa_ch12_karatsub...  481                Want(1);
ffa_ch12_karatsub...  482                Push;
ffa_ch12_karatsub...  483                FFA_FZ_Square(X     => Stack(SP - 1),
ffa_ch12_karatsub...  484                              XX_Lo => Stack(SP - 1),
ffa_ch12_karatsub...  485                              XX_Hi => Stack(SP));
ffa_ch12_karatsub...  486                ---------------------------------------------------------
ffa_ch12_karatsub...  487                
ffa_ch4_ffacalc.kv    488                ----------
ffa_ch4_ffacalc.kv    489                -- NOPs --
ffa_ch4_ffacalc.kv    490                ----------
ffa_ch4_ffacalc.kv    491                
ffa_ch4_ffacalc.kv    492                -- Ops we have not yet spoken of -- do nothing
ffa_ch4_ffacalc.kv    493             when others =>
ffa_ch4_ffacalc.kv    494                null;
ffa_ch4_ffacalc.kv    495                
ffa_ch4_ffacalc.kv    496          end case;
ffa_ch4_ffacalc.kv    497          
ffa_ch4_ffacalc.kv    498       end Op_Normal;
ffa_ch4_ffacalc.kv    499       
ffa_ch4_ffacalc.kv    500       
ffa_ch4_ffacalc.kv    501       -- Process a Symbol
ffa_ch4_ffacalc.kv    502       procedure Op(C : in Character) is
ffa_ch4_ffacalc.kv    503       begin
ffa_ch4_ffacalc.kv    504          -- First, see whether we are in a state of nestedness:
ffa_ch4_ffacalc.kv    505          
ffa_ch4_ffacalc.kv    506          -- ... in a Comment block:
ffa_ch4_ffacalc.kv    507          if CommLevel > 0 then
ffa_ch4_ffacalc.kv    508             case C is
ffa_ch4_ffacalc.kv    509                when ')' =>  -- Drop a nesting level:
ffa_ch4_ffacalc.kv    510                   CommLevel := CommLevel - 1;
ffa_ch4_ffacalc.kv    511                when '(' =>  -- Add a nesting level:
ffa_ch4_ffacalc.kv    512                   CommLevel := CommLevel + 1;
ffa_ch4_ffacalc.kv    513                when others =>
ffa_ch4_ffacalc.kv    514                   null; -- Other symbols have no effect at all
ffa_ch4_ffacalc.kv    515             end case;
ffa_ch4_ffacalc.kv    516             
ffa_ch4_ffacalc.kv    517             -- ... in a Quote block:
ffa_ch4_ffacalc.kv    518          elsif QuoteLevel > 0 then
ffa_ch4_ffacalc.kv    519             case C is
ffa_ch4_ffacalc.kv    520                when ']' =>   -- Drop a nesting level:
ffa_ch4_ffacalc.kv    521                   QuoteLevel := QuoteLevel - 1;
ffa_ch4_ffacalc.kv    522                when '[' =>   -- Add a nesting level:
ffa_ch4_ffacalc.kv    523                   QuoteLevel := QuoteLevel + 1;
ffa_ch4_ffacalc.kv    524                when others =>
ffa_ch4_ffacalc.kv    525                   null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv    526             end case;
ffa_ch4_ffacalc.kv    527             
ffa_ch4_ffacalc.kv    528             -- If we aren't the mode-exiting ']', print current symbol:
ffa_ch4_ffacalc.kv    529             if QuoteLevel > 0 then
ffa_ch4_ffacalc.kv    530                Write_Char(C);
ffa_ch4_ffacalc.kv    531             end if;
ffa_ch4_ffacalc.kv    532             
ffa_ch4_ffacalc.kv    533             --- ... in a ~taken~ Conditional branch:
ffa_ch4_ffacalc.kv    534          elsif CondLevel > 0 then
ffa_ch4_ffacalc.kv    535             case C is
ffa_ch4_ffacalc.kv    536                when '}' =>   -- Drop a nesting level:
ffa_ch4_ffacalc.kv    537                   CondLevel := CondLevel - 1;
ffa_ch4_ffacalc.kv    538                   
ffa_ch4_ffacalc.kv    539                   -- If we exited the Conditional as a result,
ffa_ch4_ffacalc.kv    540                   -- we push a 1 to trigger the possible 'else' clause:
ffa_ch4_ffacalc.kv    541                   if CondLevel = 0 then
ffa_ch4_ffacalc.kv    542                      Push;
ffa_ch11_tuning_a...  543                      FFA_WBool_To_FZ(1, Stack(SP));
ffa_ch4_ffacalc.kv    544                   end if;
ffa_ch4_ffacalc.kv    545                   
ffa_ch4_ffacalc.kv    546                when '{' =>   -- Add a nesting level:
ffa_ch4_ffacalc.kv    547                   CondLevel := CondLevel + 1;
ffa_ch4_ffacalc.kv    548                when others =>
ffa_ch4_ffacalc.kv    549                   null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv    550             end case;
ffa_ch4_ffacalc.kv    551          else
ffa_ch4_ffacalc.kv    552             -- This is a Normal Op, so proceed with the normal rules.
ffa_ch4_ffacalc.kv    553             Op_Normal(C);
ffa_ch4_ffacalc.kv    554          end if;
ffa_ch4_ffacalc.kv    555          
ffa_ch4_ffacalc.kv    556       end Op;
ffa_ch4_ffacalc.kv    557       
ffa_ch4_ffacalc.kv    558       
ffa_ch4_ffacalc.kv    559       -- Current Character
ffa_ch4_ffacalc.kv    560       C : Character;
ffa_ch4_ffacalc.kv    561       
ffa_ch4_ffacalc.kv    562    begin
ffa_ch4_ffacalc.kv    563       -- Reset the Calculator      
ffa_ch4_ffacalc.kv    564       Zap;
ffa_ch4_ffacalc.kv    565       -- Process characters until EOF:
ffa_ch4_ffacalc.kv    566       loop
ffa_ch4_ffacalc.kv    567          if Read_Char(C) then
ffa_ch4_ffacalc.kv    568             -- Execute Op:
ffa_ch4_ffacalc.kv    569             Op(C);
ffa_ch4_ffacalc.kv    570             -- Advance Odometer
ffa_ch4_ffacalc.kv    571             Pos := Pos + 1;
ffa_ch4_ffacalc.kv    572          else
ffa_ch4_ffacalc.kv    573             Zap;
ffa_ch4_ffacalc.kv    574             Quit(0); -- if EOF, we're done
ffa_ch4_ffacalc.kv    575          end if;
ffa_ch4_ffacalc.kv    576       end loop;
ffa_ch4_ffacalc.kv    577    end;
ffa_ch4_ffacalc.kv    578    
ffa_ch4_ffacalc.kv    579 end FFA_Calc;