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_ch15_gcd.kv         5 -- (C) 2019 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_ch14_barrett.kv    21 with Version;  use Version;
ffa_ch8_randomism.kv   22 with OS;       use OS;
ffa_ch8_randomism.kv   23 with CmdLine;  use CmdLine;
ffa_ch4_ffacalc.kv     24 
ffa_ch4_ffacalc.kv     25 -- FFA
ffa_ch11_tuning_a...   26 with FFA;      use FFA;
ffa_ch4_ffacalc.kv     27 
ffa_ch11_tuning_a...   28 -- For the intrinsic equality operator on Words
ffa_ch11_tuning_a...   29 use type FFA.Word;
ffa_ch4_ffacalc.kv     30 
ffa_ch8_randomism.kv   31 -- For RNG:
ffa_ch8_randomism.kv   32 with FFA_RNG;  use FFA_RNG;
ffa_ch8_randomism.kv   33 
ffa_ch8_randomism.kv   34 
ffa_ch4_ffacalc.kv     35 procedure FFA_Calc is
ffa_ch4_ffacalc.kv     36    
ffa_ch14_barrett.kv    37    Width   : Positive;   -- Desired FFA Width
ffa_ch14_barrett.kv    38    Height  : Positive;   -- Desired Height of Stack
ffa_ch14_barrett.kv    39    RNG     : RNG_Device; -- The active RNG device.
ffa_ch4_ffacalc.kv     40    
ffa_ch4_ffacalc.kv     41 begin
ffa_ch8_randomism.kv   42    if Arg_Count < 3 or Arg_Count > 4 then
ffa_ch8_randomism.kv   43       Eggog("Usage: ./ffa_calc WIDTH HEIGHT [/dev/rng]");
ffa_ch4_ffacalc.kv     44    end if;
ffa_ch4_ffacalc.kv     45    
ffa_ch4_ffacalc.kv     46    declare
ffa_ch4_ffacalc.kv     47       Arg1 : CmdLineArg;
ffa_ch4_ffacalc.kv     48       Arg2 : CmdLineArg;
ffa_ch4_ffacalc.kv     49    begin
ffa_ch4_ffacalc.kv     50       -- Get commandline args:
ffa_ch4_ffacalc.kv     51       Get_Argument(1, Arg1); -- First arg
ffa_ch4_ffacalc.kv     52       Get_Argument(2, Arg2); -- Second arg
ffa_ch4_ffacalc.kv     53       
ffa_ch8_randomism.kv   54       if Arg_Count = 4 then
ffa_ch8_randomism.kv   55          -- RNG was specified:
ffa_ch8_randomism.kv   56          declare
ffa_ch8_randomism.kv   57             Arg3 : CmdLineArg;
ffa_ch8_randomism.kv   58          begin
ffa_ch8_randomism.kv   59             Get_Argument(3, Arg3); -- Third arg (optional)
ffa_ch8_randomism.kv   60             
ffa_ch8_randomism.kv   61             -- Ada.Sequential_IO chokes on paths with trailing whitespace!
ffa_ch8_randomism.kv   62             -- So we have to give it a trimmed path. But we can't use
ffa_ch8_randomism.kv   63             -- Ada.Strings.Fixed.Trim, because it suffers from
ffa_ch8_randomism.kv   64             -- SecondaryStackism-syphilis. Instead we are stuck doing this:
ffa_ch8_randomism.kv   65             Init_RNG(RNG, Arg3(Arg3'First .. Len_Arg(3)));
ffa_ch8_randomism.kv   66          end;
ffa_ch8_randomism.kv   67       else
ffa_ch8_randomism.kv   68          -- RNG was NOT specified:
ffa_ch8_randomism.kv   69          Init_RNG(RNG); -- Use the machine default then
ffa_ch8_randomism.kv   70       end if;
ffa_ch8_randomism.kv   71       
ffa_ch4_ffacalc.kv     72       -- Parse into Positives:
ffa_ch4_ffacalc.kv     73       Width  := Positive'Value(Arg1);
ffa_ch4_ffacalc.kv     74       Height := Positive'Value(Arg2);
ffa_ch4_ffacalc.kv     75    exception
ffa_ch4_ffacalc.kv     76       when others =>
ffa_ch4_ffacalc.kv     77          Eggog("Invalid arguments!");
ffa_ch4_ffacalc.kv     78    end;
ffa_ch4_ffacalc.kv     79    
ffa_ch4_ffacalc.kv     80    -- Test if proposed Width is permissible:
ffa_ch11_tuning_a...   81    if not FFA_FZ_Valid_Bitness_P(Width) then
ffa_ch11_tuning_a...   82       Eggog("Invalid Width: " & FFA_Validity_Rule_Doc);
ffa_ch4_ffacalc.kv     83    end if;
ffa_ch4_ffacalc.kv     84    
ffa_ch4_ffacalc.kv     85    -- The Calculator itself:
ffa_ch4_ffacalc.kv     86    declare
ffa_ch4_ffacalc.kv     87       
ffa_ch4_ffacalc.kv     88       -- The number of Words required to make a FZ of the given Bitness.
ffa_ch4_ffacalc.kv     89       Wordness : Indices := Indices(Width / Bitness);
ffa_ch4_ffacalc.kv     90       
ffa_ch4_ffacalc.kv     91       --------------------------------------------------------
ffa_ch4_ffacalc.kv     92       -- State --
ffa_ch4_ffacalc.kv     93       --------------------------------------------------------
ffa_ch4_ffacalc.kv     94       -- The Stack:
ffa_ch4_ffacalc.kv     95       subtype Stack_Positions is Natural range 0 .. Height;
ffa_ch4_ffacalc.kv     96       type Stacks is array(Stack_Positions range <>) of FZ(1 .. Wordness);
ffa_ch4_ffacalc.kv     97       Stack      : Stacks(Stack_Positions'Range);
ffa_ch4_ffacalc.kv     98       
ffa_ch4_ffacalc.kv     99       -- Stack Pointer:
ffa_ch4_ffacalc.kv    100       SP         : Stack_Positions := Stack_Positions'First;
ffa_ch4_ffacalc.kv    101       
ffa_ch4_ffacalc.kv    102       -- Carry/Borrow Flag:
ffa_ch4_ffacalc.kv    103       Flag       : WBool   := 0;
ffa_ch4_ffacalc.kv    104       
ffa_ch4_ffacalc.kv    105       -- Odometer:
ffa_ch4_ffacalc.kv    106       Pos        : Natural := 0;
ffa_ch4_ffacalc.kv    107       
ffa_ch4_ffacalc.kv    108       -- The current levels of the three types of nestedness:
ffa_ch4_ffacalc.kv    109       QuoteLevel : Natural := 0;
ffa_ch4_ffacalc.kv    110       CommLevel  : Natural := 0;
ffa_ch4_ffacalc.kv    111       CondLevel  : Natural := 0;
ffa_ch13_measure_...  112       
ffa_ch13_measure_...  113       -- Prefixed Operators
ffa_ch13_measure_...  114       PrevC      : Character := ' ';
ffa_ch13_measure_...  115       HavePrefix : Boolean   := False;
ffa_ch13_measure_...  116       
ffa_ch4_ffacalc.kv    117       --------------------------------------------------------
ffa_ch4_ffacalc.kv    118       
ffa_ch4_ffacalc.kv    119       
ffa_ch4_ffacalc.kv    120       -- Clear the stack and set SP to bottom.
ffa_ch4_ffacalc.kv    121       procedure Zap is
ffa_ch4_ffacalc.kv    122       begin
ffa_ch4_ffacalc.kv    123          -- Clear the stack
ffa_ch4_ffacalc.kv    124          for i in Stack'Range loop
ffa_ch11_tuning_a...  125             FFA_FZ_Clear(Stack(i));
ffa_ch4_ffacalc.kv    126          end loop;
ffa_ch4_ffacalc.kv    127          -- Set SP to bottom
ffa_ch4_ffacalc.kv    128          SP   := Stack_Positions'First;
ffa_ch4_ffacalc.kv    129          -- Clear Overflow flag
ffa_ch4_ffacalc.kv    130          Flag := 0;
ffa_ch13_measure_...  131          -- Clear prefix
ffa_ch13_measure_...  132          HavePrefix := False;
ffa_ch13_measure_...  133          PrevC      := ' ';
ffa_ch4_ffacalc.kv    134       end Zap;
ffa_ch4_ffacalc.kv    135       
ffa_ch4_ffacalc.kv    136       
ffa_ch4_ffacalc.kv    137       -- Report a fatal error condition at the current symbol
ffa_ch4_ffacalc.kv    138       procedure E(S : in String) is
ffa_ch4_ffacalc.kv    139       begin
ffa_ch4_ffacalc.kv    140          Eggog("Pos:" & Natural'Image(Pos) & ": " & S);
ffa_ch4_ffacalc.kv    141       end E;
ffa_ch4_ffacalc.kv    142       
ffa_ch4_ffacalc.kv    143       
ffa_ch4_ffacalc.kv    144       -- Move SP up
ffa_ch4_ffacalc.kv    145       procedure Push is
ffa_ch4_ffacalc.kv    146       begin
ffa_ch4_ffacalc.kv    147          if SP = Stack_Positions'Last then
ffa_ch4_ffacalc.kv    148             E("Stack Overflow!");
ffa_ch4_ffacalc.kv    149          else
ffa_ch4_ffacalc.kv    150             SP := SP + 1;
ffa_ch4_ffacalc.kv    151          end if;
ffa_ch4_ffacalc.kv    152       end Push;
ffa_ch4_ffacalc.kv    153       
ffa_ch4_ffacalc.kv    154       
ffa_ch4_ffacalc.kv    155       -- Discard the top of the stack
ffa_ch4_ffacalc.kv    156       procedure Drop is
ffa_ch4_ffacalc.kv    157       begin
ffa_ch11_tuning_a...  158          FFA_FZ_Clear(Stack(SP));
ffa_ch4_ffacalc.kv    159          SP := SP - 1;
ffa_ch4_ffacalc.kv    160       end Drop;
ffa_ch4_ffacalc.kv    161       
ffa_ch4_ffacalc.kv    162       
ffa_ch4_ffacalc.kv    163       -- Check if stack has the necessary N items
ffa_ch4_ffacalc.kv    164       procedure Want(N : in Positive) is
ffa_ch4_ffacalc.kv    165       begin
ffa_ch4_ffacalc.kv    166          if SP < N then
ffa_ch4_ffacalc.kv    167             E("Stack Underflow!");
ffa_ch4_ffacalc.kv    168          end if;
ffa_ch4_ffacalc.kv    169       end Want;
ffa_ch4_ffacalc.kv    170       
ffa_ch4_ffacalc.kv    171       
ffa_ch5_egypt.kv      172       -- Ensure that a divisor is not zero
ffa_ch5_egypt.kv      173       procedure MustNotZero(D : in FZ) is
ffa_ch5_egypt.kv      174       begin
ffa_ch11_tuning_a...  175          if FFA_FZ_ZeroP(D) = 1 then
ffa_ch5_egypt.kv      176             E("Division by Zero!");
ffa_ch5_egypt.kv      177          end if;
ffa_ch5_egypt.kv      178       end MustNotZero;
ffa_ch5_egypt.kv      179       
ffa_ch5_egypt.kv      180       
ffa_ch4_ffacalc.kv    181       -- Slide a new hex digit into the FZ on top of stack
ffa_ch11_tuning_a...  182       procedure Ins_Hex_Digit(Digit : in Nibble) is
ffa_ch11_tuning_a...  183          Overflow : WBool := 0;
ffa_ch4_ffacalc.kv    184       begin
ffa_ch11_tuning_a...  185          
ffa_ch11_tuning_a...  186          -- Insert the given nibble, and detect any overflow:
ffa_ch11_tuning_a...  187          FFA_FZ_Insert_Bottom_Nibble(N        => Stack(SP),
ffa_ch11_tuning_a...  188                                      D        => Digit,
ffa_ch11_tuning_a...  189                                      Overflow => Overflow);
ffa_ch4_ffacalc.kv    190          
ffa_ch4_ffacalc.kv    191          -- Constants which exceed the Width are forbidden:
ffa_ch11_tuning_a...  192          if Overflow = 1 then
ffa_ch4_ffacalc.kv    193             E("Constant Exceeds Bitness!");
ffa_ch4_ffacalc.kv    194          end if;
ffa_ch4_ffacalc.kv    195          
ffa_ch4_ffacalc.kv    196       end;
ffa_ch4_ffacalc.kv    197       
ffa_ch4_ffacalc.kv    198       
ffa_ch11_tuning_a...  199       -- Emit an ASCII representation of N to the terminal
ffa_ch11_tuning_a...  200       procedure Print_FZ(N : in FZ) is
ffa_ch11_tuning_a...  201          S : String(1 .. FFA_FZ_ASCII_Length(N)); -- Mandatorily, exact size
ffa_ch11_tuning_a...  202       begin
ffa_ch11_tuning_a...  203          FFA_FZ_To_Hex_String(N, S); -- Convert N to ASCII hex
ffa_ch11_tuning_a...  204          Write_String(S);            -- Print the result to stdout
ffa_ch11_tuning_a...  205          Write_Newline;              -- Print newline, for clarity.
ffa_ch11_tuning_a...  206       end Print_FZ;
ffa_ch11_tuning_a...  207       
ffa_ch11_tuning_a...  208       
ffa_ch13_measure_...  209       -- Denote that the given op is a prefix
ffa_ch13_measure_...  210       procedure IsPrefix is
ffa_ch13_measure_...  211       begin
ffa_ch13_measure_...  212          HavePrefix := True;
ffa_ch13_measure_...  213       end IsPrefix;
ffa_ch13_measure_...  214       
ffa_ch13_measure_...  215       
ffa_ch4_ffacalc.kv    216       -- Execute a Normal Op
ffa_ch4_ffacalc.kv    217       procedure Op_Normal(C : in Character) is
ffa_ch4_ffacalc.kv    218          
ffa_ch4_ffacalc.kv    219          -- Over/underflow output from certain ops
ffa_ch4_ffacalc.kv    220          F : Word;
ffa_ch4_ffacalc.kv    221          
ffa_ch4_ffacalc.kv    222       begin
ffa_ch4_ffacalc.kv    223          
ffa_ch4_ffacalc.kv    224          case C is
ffa_ch4_ffacalc.kv    225             
ffa_ch4_ffacalc.kv    226             --------------
ffa_ch4_ffacalc.kv    227             -- Stickies --
ffa_ch4_ffacalc.kv    228             --------------
ffa_ch4_ffacalc.kv    229             -- Enter Commented
ffa_ch4_ffacalc.kv    230             when '(' =>
ffa_ch4_ffacalc.kv    231                CommLevel := 1;
ffa_ch4_ffacalc.kv    232                
ffa_ch4_ffacalc.kv    233                -- Exit Commented (but we aren't in it!)
ffa_ch4_ffacalc.kv    234             when ')' =>
ffa_ch4_ffacalc.kv    235                E("Mismatched close-comment parenthesis !");
ffa_ch4_ffacalc.kv    236                
ffa_ch4_ffacalc.kv    237                -- Enter Quoted
ffa_ch4_ffacalc.kv    238             when '[' =>
ffa_ch4_ffacalc.kv    239                QuoteLevel := 1;
ffa_ch4_ffacalc.kv    240                
ffa_ch4_ffacalc.kv    241                -- Exit Quoted (but we aren't in it!)
ffa_ch4_ffacalc.kv    242             when ']' =>
ffa_ch4_ffacalc.kv    243                E("Mismatched close-quote bracket !");
ffa_ch4_ffacalc.kv    244                
ffa_ch4_ffacalc.kv    245                -- Enter a ~taken~ Conditional branch:
ffa_ch4_ffacalc.kv    246             when '{' =>
ffa_ch4_ffacalc.kv    247                Want(1);
ffa_ch11_tuning_a...  248                if FFA_FZ_ZeroP(Stack(SP)) = 1 then
ffa_ch4_ffacalc.kv    249                   CondLevel := 1;
ffa_ch4_ffacalc.kv    250                end if;
ffa_ch4_ffacalc.kv    251                Drop;
ffa_ch4_ffacalc.kv    252                
ffa_ch4_ffacalc.kv    253                -- Exit from a ~non-taken~ Conditional branch:
ffa_ch4_ffacalc.kv    254                -- ... we push a 0, to suppress the 'else' clause
ffa_ch4_ffacalc.kv    255             when '}' =>
ffa_ch4_ffacalc.kv    256                Push;
ffa_ch11_tuning_a...  257                FFA_WBool_To_FZ(0, Stack(SP));
ffa_ch4_ffacalc.kv    258                
ffa_ch4_ffacalc.kv    259                ----------------
ffa_ch4_ffacalc.kv    260                -- Immediates --
ffa_ch4_ffacalc.kv    261                ----------------
ffa_ch4_ffacalc.kv    262                
ffa_ch4_ffacalc.kv    263                -- These operate on the FZ ~currently~ at top of the stack;
ffa_ch4_ffacalc.kv    264                -- and this means that the stack may NOT be empty.
ffa_ch4_ffacalc.kv    265                
ffa_ch4_ffacalc.kv    266             when '0' .. '9' =>
ffa_ch4_ffacalc.kv    267                Want(1);
ffa_ch11_tuning_a...  268                Ins_Hex_Digit(Character'Pos(C) - Character'Pos('0'));
ffa_ch4_ffacalc.kv    269                
ffa_ch4_ffacalc.kv    270             when 'A' .. 'F' =>
ffa_ch4_ffacalc.kv    271                Want(1);
ffa_ch11_tuning_a...  272                Ins_Hex_Digit(10 + Character'Pos(C) - Character'Pos('A'));
ffa_ch4_ffacalc.kv    273                
ffa_ch4_ffacalc.kv    274             when 'a' .. 'f' =>
ffa_ch4_ffacalc.kv    275                Want(1);
ffa_ch11_tuning_a...  276                Ins_Hex_Digit(10 + Character'Pos(C) - Character'Pos('a'));
ffa_ch4_ffacalc.kv    277                
ffa_ch4_ffacalc.kv    278                ------------------
ffa_ch4_ffacalc.kv    279                -- Stack Motion --
ffa_ch4_ffacalc.kv    280                ------------------
ffa_ch4_ffacalc.kv    281                
ffa_ch4_ffacalc.kv    282                -- Push a 0 onto the stack
ffa_ch4_ffacalc.kv    283             when '.' =>
ffa_ch4_ffacalc.kv    284                Push;
ffa_ch11_tuning_a...  285                FFA_FZ_Clear(Stack(SP));
ffa_ch4_ffacalc.kv    286                
ffa_ch4_ffacalc.kv    287                -- Dup
ffa_ch4_ffacalc.kv    288             when '"' =>
ffa_ch4_ffacalc.kv    289                Want(1);
ffa_ch4_ffacalc.kv    290                Push;
ffa_ch4_ffacalc.kv    291                Stack(SP) := Stack(SP - 1);
ffa_ch4_ffacalc.kv    292                
ffa_ch4_ffacalc.kv    293                -- Drop
ffa_ch4_ffacalc.kv    294             when '_' =>
ffa_ch4_ffacalc.kv    295                Want(1);
ffa_ch4_ffacalc.kv    296                Drop;
ffa_ch4_ffacalc.kv    297                
ffa_ch4_ffacalc.kv    298                -- Swap
ffa_ch4_ffacalc.kv    299             when ''' =>
ffa_ch4_ffacalc.kv    300                Want(2);
ffa_ch11_tuning_a...  301                FFA_FZ_Swap(Stack(SP), Stack(SP - 1));
ffa_ch4_ffacalc.kv    302                
ffa_ch4_ffacalc.kv    303                -- Over
ffa_ch4_ffacalc.kv    304             when '`' =>
ffa_ch4_ffacalc.kv    305                Want(2);
ffa_ch4_ffacalc.kv    306                Push;
ffa_ch4_ffacalc.kv    307                Stack(SP) := Stack(SP - 2);
ffa_ch4_ffacalc.kv    308                
ffa_ch4_ffacalc.kv    309                ----------------
ffa_ch4_ffacalc.kv    310                -- Predicates --
ffa_ch4_ffacalc.kv    311                ----------------
ffa_ch4_ffacalc.kv    312                
ffa_ch4_ffacalc.kv    313                -- Equality
ffa_ch4_ffacalc.kv    314             when '=' =>
ffa_ch4_ffacalc.kv    315                Want(2);
ffa_ch11_tuning_a...  316                FFA_WBool_To_FZ(FFA_FZ_EqP(X => Stack(SP),
ffa_ch11_tuning_a...  317                                           Y => Stack(SP - 1)),
ffa_ch11_tuning_a...  318                                Stack(SP - 1));
ffa_ch4_ffacalc.kv    319                Drop;
ffa_ch4_ffacalc.kv    320                
ffa_ch4_ffacalc.kv    321                -- Less-Than
ffa_ch4_ffacalc.kv    322             when '<' =>
ffa_ch4_ffacalc.kv    323                Want(2);
ffa_ch11_tuning_a...  324                FFA_WBool_To_FZ(FFA_FZ_LessThanP(X => Stack(SP - 1),
ffa_ch11_tuning_a...  325                                                 Y => Stack(SP)),
ffa_ch11_tuning_a...  326                                Stack(SP - 1));
ffa_ch4_ffacalc.kv    327                Drop;
ffa_ch4_ffacalc.kv    328                
ffa_ch4_ffacalc.kv    329                -- Greater-Than
ffa_ch4_ffacalc.kv    330             when '>' =>
ffa_ch4_ffacalc.kv    331                Want(2);
ffa_ch11_tuning_a...  332                FFA_WBool_To_FZ(FFA_FZ_GreaterThanP(X => Stack(SP - 1),
ffa_ch11_tuning_a...  333                                                    Y => Stack(SP)),
ffa_ch11_tuning_a...  334                                Stack(SP - 1));
ffa_ch4_ffacalc.kv    335                Drop;
ffa_ch4_ffacalc.kv    336                
ffa_ch4_ffacalc.kv    337                ----------------
ffa_ch4_ffacalc.kv    338                -- Arithmetic --
ffa_ch4_ffacalc.kv    339                ----------------
ffa_ch4_ffacalc.kv    340                
ffa_ch4_ffacalc.kv    341                -- Subtract
ffa_ch4_ffacalc.kv    342             when '-' =>
ffa_ch4_ffacalc.kv    343                Want(2);
ffa_ch11_tuning_a...  344                FFA_FZ_Subtract(X          => Stack(SP - 1),
ffa_ch11_tuning_a...  345                                Y          => Stack(SP),
ffa_ch11_tuning_a...  346                                Difference => Stack(SP - 1),
ffa_ch11_tuning_a...  347                                Underflow  => F);
ffa_ch11_tuning_a...  348                Flag := FFA_Word_NZeroP(F);
ffa_ch4_ffacalc.kv    349                Drop;
ffa_ch4_ffacalc.kv    350                
ffa_ch4_ffacalc.kv    351                -- Add
ffa_ch4_ffacalc.kv    352             when '+' =>
ffa_ch4_ffacalc.kv    353                Want(2);
ffa_ch11_tuning_a...  354                FFA_FZ_Add(X        => Stack(SP - 1),
ffa_ch11_tuning_a...  355                           Y        => Stack(SP),
ffa_ch11_tuning_a...  356                           Sum      => Stack(SP - 1),
ffa_ch11_tuning_a...  357                           Overflow => F);
ffa_ch11_tuning_a...  358                Flag := FFA_Word_NZeroP(F);
ffa_ch4_ffacalc.kv    359                Drop;
ffa_ch4_ffacalc.kv    360                
ffa_ch5_egypt.kv      361                -- Divide and give Quotient and Remainder
ffa_ch5_egypt.kv      362             when '\' =>
ffa_ch5_egypt.kv      363                Want(2);
ffa_ch5_egypt.kv      364                MustNotZero(Stack(SP));
ffa_ch11_tuning_a...  365                FFA_FZ_IDiv(Dividend  => Stack(SP - 1),
ffa_ch11_tuning_a...  366                            Divisor   => Stack(SP),
ffa_ch11_tuning_a...  367                            Quotient  => Stack(SP - 1),
ffa_ch11_tuning_a...  368                            Remainder => Stack(SP));
ffa_ch5_egypt.kv      369                
ffa_ch5_egypt.kv      370                -- Divide and give Quotient only
ffa_ch5_egypt.kv      371             when '/' =>
ffa_ch5_egypt.kv      372                Want(2);
ffa_ch5_egypt.kv      373                MustNotZero(Stack(SP));
ffa_ch11_tuning_a...  374                FFA_FZ_Div(Dividend  => Stack(SP - 1),
ffa_ch11_tuning_a...  375                           Divisor   => Stack(SP),
ffa_ch11_tuning_a...  376                           Quotient  => Stack(SP - 1));
ffa_ch5_egypt.kv      377                Drop;
ffa_ch5_egypt.kv      378                
ffa_ch5_egypt.kv      379                -- Divide and give Remainder only
ffa_ch5_egypt.kv      380             when '%' =>
ffa_ch5_egypt.kv      381                Want(2);
ffa_ch5_egypt.kv      382                MustNotZero(Stack(SP));
ffa_ch11_tuning_a...  383                FFA_FZ_Mod(Dividend  => Stack(SP - 1),
ffa_ch11_tuning_a...  384                           Divisor   => Stack(SP),
ffa_ch11_tuning_a...  385                           Remainder => Stack(SP - 1));
ffa_ch5_egypt.kv      386                Drop;
ffa_ch5_egypt.kv      387                
ffa_ch5_egypt.kv      388                -- Multiply, give bottom and top halves
ffa_ch5_egypt.kv      389             when '*' =>
ffa_ch5_egypt.kv      390                Want(2);
ffa_ch11_tuning_a...  391                FFA_FZ_Multiply(X     => Stack(SP - 1),
ffa_ch11_tuning_a...  392                                Y     => Stack(SP),
ffa_ch11_tuning_a...  393                                XY_Lo => Stack(SP - 1),
ffa_ch11_tuning_a...  394                                XY_Hi => Stack(SP));
ffa_ch5_egypt.kv      395                
ffa_ch15_gcd.kv       396                -- Square, give bottom and top halves
ffa_ch15_gcd.kv       397             when 'S' =>
ffa_ch15_gcd.kv       398                Want(1);
ffa_ch15_gcd.kv       399                Push;
ffa_ch15_gcd.kv       400                FFA_FZ_Square(X     => Stack(SP - 1),
ffa_ch15_gcd.kv       401                              XX_Lo => Stack(SP - 1),
ffa_ch15_gcd.kv       402                              XX_Hi => Stack(SP));
ffa_ch15_gcd.kv       403                
ffa_ch15_gcd.kv       404                -- Greatest Common Divisor (GCD)
ffa_ch15_gcd.kv       405             when 'G' =>
ffa_ch15_gcd.kv       406                Want(2);
ffa_ch15_gcd.kv       407                
ffa_ch15_gcd.kv       408                -- Note that GCD(0,0) is not factually zero, or unique.
ffa_ch15_gcd.kv       409                -- But it is permissible to define it as zero.
ffa_ch15_gcd.kv       410                -- (See Ch. 15 discussion.)
ffa_ch15_gcd.kv       411                
ffa_ch15_gcd.kv       412                FFA_FZ_Greatest_Common_Divisor(X      => Stack(SP - 1),
ffa_ch15_gcd.kv       413                                               Y      => Stack(SP),
ffa_ch15_gcd.kv       414                                               Result => Stack(SP - 1));
ffa_ch15_gcd.kv       415                Drop;
ffa_ch15_gcd.kv       416                
ffa_ch4_ffacalc.kv    417                -----------------
ffa_ch4_ffacalc.kv    418                -- Bitwise Ops --
ffa_ch4_ffacalc.kv    419                -----------------
ffa_ch4_ffacalc.kv    420                
ffa_ch4_ffacalc.kv    421                -- Bitwise-And
ffa_ch4_ffacalc.kv    422             when '&' =>
ffa_ch4_ffacalc.kv    423                Want(2);
ffa_ch11_tuning_a...  424                FFA_FZ_And(X      => Stack(SP - 1),
ffa_ch11_tuning_a...  425                           Y      => Stack(SP),
ffa_ch11_tuning_a...  426                           Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv    427                Drop;
ffa_ch4_ffacalc.kv    428                
ffa_ch4_ffacalc.kv    429                -- Bitwise-Or
ffa_ch4_ffacalc.kv    430             when '|' =>
ffa_ch4_ffacalc.kv    431                Want(2);
ffa_ch11_tuning_a...  432                FFA_FZ_Or(X      => Stack(SP - 1),
ffa_ch11_tuning_a...  433                          Y      => Stack(SP),
ffa_ch11_tuning_a...  434                          Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv    435                Drop;
ffa_ch4_ffacalc.kv    436                
ffa_ch4_ffacalc.kv    437                -- Bitwise-Xor
ffa_ch4_ffacalc.kv    438             when '^' =>
ffa_ch4_ffacalc.kv    439                Want(2);
ffa_ch11_tuning_a...  440                FFA_FZ_Xor(X      => Stack(SP - 1),
ffa_ch11_tuning_a...  441                           Y      => Stack(SP),
ffa_ch11_tuning_a...  442                           Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv    443                Drop;
ffa_ch4_ffacalc.kv    444                
ffa_ch4_ffacalc.kv    445                -- Bitwise-Not (1s-Complement)
ffa_ch4_ffacalc.kv    446             when '~' =>
ffa_ch4_ffacalc.kv    447                Want(1);
ffa_ch11_tuning_a...  448                FFA_FZ_Not(Stack(SP), Stack(SP));
ffa_ch4_ffacalc.kv    449                
ffa_ch4_ffacalc.kv    450                -----------
ffa_ch4_ffacalc.kv    451                -- Other --
ffa_ch4_ffacalc.kv    452                -----------
ffa_ch4_ffacalc.kv    453                
ffa_ch8_randomism.kv  454                -- Push a FZ of RNGolade onto the stack
ffa_ch8_randomism.kv  455             when '?' =>
ffa_ch8_randomism.kv  456                Push;
ffa_ch11_tuning_a...  457                FFA_FZ_Clear(Stack(SP));
ffa_ch8_randomism.kv  458                FZ_Random(RNG, Stack(SP));
ffa_ch8_randomism.kv  459                
ffa_ch4_ffacalc.kv    460                -- mUx
ffa_ch4_ffacalc.kv    461             when 'U' =>
ffa_ch4_ffacalc.kv    462                Want(3);
ffa_ch11_tuning_a...  463                FFA_FZ_Mux(X      => Stack(SP - 2),
ffa_ch11_tuning_a...  464                           Y      => Stack(SP - 1),
ffa_ch11_tuning_a...  465                           Result => Stack(SP - 2),
ffa_ch11_tuning_a...  466                           Sel    => FFA_FZ_NZeroP(Stack(SP)));
ffa_ch4_ffacalc.kv    467                Drop;
ffa_ch4_ffacalc.kv    468                Drop;
ffa_ch4_ffacalc.kv    469                
ffa_ch13_measure_...  470                -- Find the position of eldest nonzero bit, if any exist
ffa_ch13_measure_...  471             when 'W' =>
ffa_ch13_measure_...  472                Want(1);
ffa_ch13_measure_...  473                declare
ffa_ch13_measure_...  474                   -- Find the measure ( 0 if no 1s, or 1 .. FZBitness )
ffa_ch14_barrett.kv   475                   Measure : FZBit_Index := FFA_FZ_Measure(Stack(SP));
ffa_ch14_barrett.kv   476                begin
ffa_ch13_measure_...  477                   -- Put on top of stack
ffa_ch13_measure_...  478                   FFA_FZ_Clear(Stack(SP));
ffa_ch14_barrett.kv   479                   FFA_FZ_Set_Head(Stack(SP), Word(Measure));
ffa_ch13_measure_...  480                end;
ffa_ch13_measure_...  481                
ffa_ch4_ffacalc.kv    482                -- Put the Overflow flag on the stack
ffa_ch4_ffacalc.kv    483             when 'O' =>
ffa_ch4_ffacalc.kv    484                Push;
ffa_ch11_tuning_a...  485                FFA_WBool_To_FZ(Flag, Stack(SP));
ffa_ch4_ffacalc.kv    486                
ffa_ch4_ffacalc.kv    487                -- Print the FZ on the top of the stack
ffa_ch4_ffacalc.kv    488             when '#' =>
ffa_ch4_ffacalc.kv    489                Want(1);
ffa_ch11_tuning_a...  490                Print_FZ(Stack(SP));
ffa_ch4_ffacalc.kv    491                Drop;
ffa_ch4_ffacalc.kv    492                
ffa_ch4_ffacalc.kv    493                -- Zap (reset)
ffa_ch4_ffacalc.kv    494             when 'Z' =>
ffa_ch4_ffacalc.kv    495                Zap;
ffa_ch4_ffacalc.kv    496                
ffa_ch4_ffacalc.kv    497                -- Quit with Stack Trace
ffa_ch4_ffacalc.kv    498             when 'Q' =>
ffa_ch4_ffacalc.kv    499                for I in reverse Stack'First + 1 .. SP loop
ffa_ch11_tuning_a...  500                   Print_FZ(Stack(I));
ffa_ch4_ffacalc.kv    501                end loop;
ffa_ch4_ffacalc.kv    502                Quit(0);
ffa_ch4_ffacalc.kv    503                
ffa_ch14_barrett.kv   504                -- Put the FFACalc Program Version on the stack,
ffa_ch14_barrett.kv   505                -- followed by FFA Program Version.
ffa_ch14_barrett.kv   506             when 'V' =>
ffa_ch14_barrett.kv   507                Push;
ffa_ch14_barrett.kv   508                Push;
ffa_ch14_barrett.kv   509                -- FFACalc Version:
ffa_ch14_barrett.kv   510                FFA_FZ_Clear(Stack(SP - 1));
ffa_ch14_barrett.kv   511                FFA_FZ_Set_Head(Stack(SP - 1), Word(FFACalc_K_Version));
ffa_ch14_barrett.kv   512                -- FFA Version:
ffa_ch14_barrett.kv   513                FFA_FZ_Clear(Stack(SP));
ffa_ch14_barrett.kv   514                FFA_FZ_Set_Head(Stack(SP), Word(FFA_K_Version));
ffa_ch14_barrett.kv   515                
ffa_ch16_miller_r...  516                -- Constant-Time Miller-Rabin Test on N using the given Witness.
ffa_ch16_miller_r...  517                -- Witness will be used as-is if it conforms to the valid range,
ffa_ch16_miller_r...  518                -- i.e. 2 <= Witness <= N - 2; else will be transformed into a
ffa_ch16_miller_r...  519                -- valid Witness via modular arithmetic.
ffa_ch16_miller_r...  520                -- Outputs ONE if N WAS FOUND composite; ZERO if NOT FOUND.
ffa_ch16_miller_r...  521                -- Handles degenerate cases of N that M-R per se cannot eat:
ffa_ch16_miller_r...  522                -- N=0, N=1: ALWAYS 'FOUND COMPOS.'; 2, 3 - ALWAYS 'NOT FOUND'.
ffa_ch16_miller_r...  523                -- If N is Even and not equal to 2, N is ALWAYS 'FOUND COMPOS.'
ffa_ch16_miller_r...  524                -- For ALL other N, the output is equal to that of the M-R test.
ffa_ch16_miller_r...  525                -- At most 1/4 of all possible Witnesses will be 'liars' for
ffa_ch16_miller_r...  526                -- a particular composite N , i.e. fail to attest to its
ffa_ch16_miller_r...  527                -- compositivity.
ffa_ch16_miller_r...  528             when 'P' =>
ffa_ch16_miller_r...  529                Want(2);
ffa_ch16_miller_r...  530                declare
ffa_ch16_miller_r...  531                   MR_Result : WBool := 
ffa_ch16_miller_r...  532                     FFA_FZ_MR_Composite_On_Witness(N       => Stack(SP - 1),
ffa_ch16_miller_r...  533                                                    Witness => Stack(SP));
ffa_ch16_miller_r...  534                begin
ffa_ch16_miller_r...  535                   FFA_WBool_To_FZ(MR_Result, Stack(SP - 1));
ffa_ch16_miller_r...  536                end;
ffa_ch16_miller_r...  537                Drop;
ffa_ch16_miller_r...  538                
ffa_ch13_measure_...  539                --------------
ffa_ch13_measure_...  540                -- Prefixes --
ffa_ch13_measure_...  541                --------------
ffa_ch13_measure_...  542                
ffa_ch13_measure_...  543                -- 'Left...'    :
ffa_ch13_measure_...  544             when 'L' =>
ffa_ch13_measure_...  545                IsPrefix;
ffa_ch13_measure_...  546                
ffa_ch13_measure_...  547                -- 'Right...'   :
ffa_ch13_measure_...  548             when 'R' =>
ffa_ch13_measure_...  549                IsPrefix;
ffa_ch13_measure_...  550                
ffa_ch13_measure_...  551                -- 'Modular...' :
ffa_ch13_measure_...  552             when 'M' =>
ffa_ch13_measure_...  553                IsPrefix;
ffa_ch13_measure_...  554                
ffa_ch13_measure_...  555                ---------------------------------------------------------
ffa_ch13_measure_...  556                -- Reserved Ops, i.e. ones we have not defined yet:   --
ffa_ch13_measure_...  557                ---------------------------------------------------------
ffa_ch13_measure_...  558             when '!' | '@' | '$' | ':' | ';' | ',' |
ffa_ch15_gcd.kv       559                  'H' | 'I' | 'J' | 'K' | 'N' |
ffa_ch16_miller_r...  560                  'T' | 'X' | 'Y' =>
ffa_ch13_measure_...  561                
ffa_ch13_measure_...  562                E("This Operator is not defined yet: " & C);
ffa_ch12_karatsub...  563                ---------------------------------------------------------
ffa_ch12_karatsub...  564                
ffa_ch4_ffacalc.kv    565                ----------
ffa_ch4_ffacalc.kv    566                -- NOPs --
ffa_ch4_ffacalc.kv    567                ----------
ffa_ch4_ffacalc.kv    568                
ffa_ch13_measure_...  569                -- Unprintables and spaces DO NOTHING:
ffa_ch4_ffacalc.kv    570             when others =>
ffa_ch4_ffacalc.kv    571                null;
ffa_ch4_ffacalc.kv    572                
ffa_ch4_ffacalc.kv    573          end case;
ffa_ch4_ffacalc.kv    574          
ffa_ch4_ffacalc.kv    575       end Op_Normal;
ffa_ch4_ffacalc.kv    576       
ffa_ch4_ffacalc.kv    577       
ffa_ch13_measure_...  578       -- Execute a Prefixed Op
ffa_ch13_measure_...  579       procedure Op_Prefixed(Prefix : in Character;
ffa_ch13_measure_...  580                             O      : in Character) is
ffa_ch13_measure_...  581       begin
ffa_ch13_measure_...  582          
ffa_ch13_measure_...  583          -- The Prefixed Op:
ffa_ch13_measure_...  584          case Prefix is
ffa_ch13_measure_...  585             
ffa_ch13_measure_...  586             ---------------------------------------------------------
ffa_ch13_measure_...  587             -- Left...
ffa_ch13_measure_...  588             when 'L' =>
ffa_ch13_measure_...  589                
ffa_ch13_measure_...  590                -- Which L-op?
ffa_ch13_measure_...  591                case O is
ffa_ch13_measure_...  592                   
ffa_ch13_measure_...  593                   -- ... Shift  :
ffa_ch13_measure_...  594                   when 'S' =>
ffa_ch13_measure_...  595                      Want(2);
ffa_ch13_measure_...  596                      declare
ffa_ch13_measure_...  597                         -- Number of bit positions to shift by:
ffa_ch13_measure_...  598                         ShiftCount : FZBit_Index
ffa_ch13_measure_...  599                           := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_...  600                      begin
ffa_ch13_measure_...  601                         FFA_FZ_Quiet_ShiftLeft(N        => Stack(SP - 1),
ffa_ch13_measure_...  602                                                ShiftedN => Stack(SP - 1),
ffa_ch13_measure_...  603                                                Count    => ShiftCount);
ffa_ch13_measure_...  604                      end;
ffa_ch13_measure_...  605                      Drop;
ffa_ch13_measure_...  606                      
ffa_ch13_measure_...  607                   -- ... Rotate :
ffa_ch13_measure_...  608                   when 'R' =>
ffa_ch13_measure_...  609                      E("Left-Rotate not yet defined!");
ffa_ch13_measure_...  610                      
ffa_ch13_measure_...  611                   -- ... Unknown:
ffa_ch13_measure_...  612                   when others =>
ffa_ch13_measure_...  613                      E("Undefined Op: L" & O);
ffa_ch13_measure_...  614                      
ffa_ch13_measure_...  615                end case;
ffa_ch13_measure_...  616             ---------------------------------------------------------
ffa_ch13_measure_...  617             -- Right...
ffa_ch13_measure_...  618             when 'R' =>
ffa_ch13_measure_...  619                
ffa_ch13_measure_...  620                -- Which R-op?
ffa_ch13_measure_...  621                case O is
ffa_ch13_measure_...  622                   
ffa_ch13_measure_...  623                   -- ... Shift:
ffa_ch13_measure_...  624                   when 'S' =>
ffa_ch13_measure_...  625                      Want(2);
ffa_ch13_measure_...  626                      declare
ffa_ch13_measure_...  627                         -- Number of bit positions to shift by:
ffa_ch13_measure_...  628                         ShiftCount : FZBit_Index
ffa_ch13_measure_...  629                           := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_...  630                      begin
ffa_ch13_measure_...  631                         FFA_FZ_Quiet_ShiftRight(N        => Stack(SP - 1),
ffa_ch13_measure_...  632                                                 ShiftedN => Stack(SP - 1),
ffa_ch13_measure_...  633                                                 Count    => ShiftCount);
ffa_ch13_measure_...  634                      end;
ffa_ch13_measure_...  635                      Drop;
ffa_ch13_measure_...  636                      
ffa_ch13_measure_...  637                   -- ... Rotate:
ffa_ch13_measure_...  638                   when 'R' =>
ffa_ch13_measure_...  639                      E("Right-Rotate not yet defined!");
ffa_ch13_measure_...  640                      
ffa_ch15_gcd.kv       641                   -- 'Right-Multiply', give only lower half of the product XY
ffa_ch15_gcd.kv       642                   when '*' =>
ffa_ch15_gcd.kv       643                      Want(2);
ffa_ch15_gcd.kv       644                      FFA_FZ_Low_Multiply(X  => Stack(SP - 1),
ffa_ch15_gcd.kv       645                                          Y  => Stack(SP),
ffa_ch15_gcd.kv       646                                          XY => Stack(SP - 1));
ffa_ch15_gcd.kv       647                      Drop;
ffa_ch15_gcd.kv       648                      
ffa_ch13_measure_...  649                   -- ... Unknown:
ffa_ch13_measure_...  650                   when others =>
ffa_ch13_measure_...  651                      E("Undefined Op: R" & O);
ffa_ch13_measure_...  652                      
ffa_ch13_measure_...  653                end case;
ffa_ch13_measure_...  654             ---------------------------------------------------------
ffa_ch15_gcd.kv       655             -- Modular...
ffa_ch13_measure_...  656             when 'M' =>
ffa_ch13_measure_...  657                
ffa_ch13_measure_...  658                -- Which M-op?
ffa_ch13_measure_...  659                case O is
ffa_ch13_measure_...  660                   
ffa_ch15_gcd.kv       661                   -- ... Multiplication (Conventional) :
ffa_ch13_measure_...  662                   when '*' =>
ffa_ch13_measure_...  663                      Want(3);
ffa_ch13_measure_...  664                      MustNotZero(Stack(SP));
ffa_ch13_measure_...  665                      FFA_FZ_Modular_Multiply(X       => Stack(SP - 2),
ffa_ch13_measure_...  666                                              Y       => Stack(SP - 1),
ffa_ch13_measure_...  667                                              Modulus => Stack(SP),
ffa_ch13_measure_...  668                                              Product => Stack(SP - 2));
ffa_ch13_measure_...  669                      Drop;
ffa_ch13_measure_...  670                      Drop;
ffa_ch13_measure_...  671                      
ffa_ch15_gcd.kv       672                   -- ... Squaring (Conventional) :
ffa_ch15_gcd.kv       673                   when 'S' =>
ffa_ch15_gcd.kv       674                      Want(2);
ffa_ch15_gcd.kv       675                      MustNotZero(Stack(SP));
ffa_ch15_gcd.kv       676                      FFA_FZ_Modular_Square(X       => Stack(SP - 1),
ffa_ch15_gcd.kv       677                                            Modulus => Stack(SP),
ffa_ch15_gcd.kv       678                                            Product => Stack(SP - 1));
ffa_ch15_gcd.kv       679                      Drop;
ffa_ch15_gcd.kv       680                      
ffa_ch15_gcd.kv       681                   -- ... Exponentiation (Barrettronic) :
ffa_ch13_measure_...  682                   when 'X' =>
ffa_ch13_measure_...  683                      Want(3);
ffa_ch13_measure_...  684                      MustNotZero(Stack(SP));
ffa_ch13_measure_...  685                      FFA_FZ_Modular_Exponentiate(Base     => Stack(SP - 2),
ffa_ch13_measure_...  686                                                  Exponent => Stack(SP - 1),
ffa_ch13_measure_...  687                                                  Modulus  => Stack(SP),
ffa_ch13_measure_...  688                                                  Result   => Stack(SP - 2));
ffa_ch13_measure_...  689                      Drop;
ffa_ch13_measure_...  690                      Drop;
ffa_ch13_measure_...  691                      
ffa_ch13_measure_...  692                   -- ... Unknown:
ffa_ch13_measure_...  693                   when others =>
ffa_ch13_measure_...  694                      E("Undefined Op: M" & O);
ffa_ch13_measure_...  695                      
ffa_ch13_measure_...  696                end case;
ffa_ch13_measure_...  697             ---------------------------------------------------------
ffa_ch13_measure_...  698             -- ... Unknown: (impossible per mechanics, but must handle case)
ffa_ch13_measure_...  699             when others =>
ffa_ch13_measure_...  700                E("Undefined Prefix: " & Prefix);
ffa_ch13_measure_...  701                
ffa_ch13_measure_...  702          end case;
ffa_ch13_measure_...  703          
ffa_ch13_measure_...  704       end Op_Prefixed;
ffa_ch13_measure_...  705       
ffa_ch13_measure_...  706       
ffa_ch4_ffacalc.kv    707       -- Process a Symbol
ffa_ch4_ffacalc.kv    708       procedure Op(C : in Character) is
ffa_ch4_ffacalc.kv    709       begin
ffa_ch4_ffacalc.kv    710          -- First, see whether we are in a state of nestedness:
ffa_ch4_ffacalc.kv    711          
ffa_ch4_ffacalc.kv    712          -- ... in a Comment block:
ffa_ch4_ffacalc.kv    713          if CommLevel > 0 then
ffa_ch4_ffacalc.kv    714             case C is
ffa_ch4_ffacalc.kv    715                when ')' =>  -- Drop a nesting level:
ffa_ch4_ffacalc.kv    716                   CommLevel := CommLevel - 1;
ffa_ch4_ffacalc.kv    717                when '(' =>  -- Add a nesting level:
ffa_ch4_ffacalc.kv    718                   CommLevel := CommLevel + 1;
ffa_ch4_ffacalc.kv    719                when others =>
ffa_ch4_ffacalc.kv    720                   null; -- Other symbols have no effect at all
ffa_ch4_ffacalc.kv    721             end case;
ffa_ch4_ffacalc.kv    722             
ffa_ch4_ffacalc.kv    723             -- ... in a Quote block:
ffa_ch4_ffacalc.kv    724          elsif QuoteLevel > 0 then
ffa_ch4_ffacalc.kv    725             case C is
ffa_ch4_ffacalc.kv    726                when ']' =>   -- Drop a nesting level:
ffa_ch4_ffacalc.kv    727                   QuoteLevel := QuoteLevel - 1;
ffa_ch4_ffacalc.kv    728                when '[' =>   -- Add a nesting level:
ffa_ch4_ffacalc.kv    729                   QuoteLevel := QuoteLevel + 1;
ffa_ch4_ffacalc.kv    730                when others =>
ffa_ch4_ffacalc.kv    731                   null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv    732             end case;
ffa_ch4_ffacalc.kv    733             
ffa_ch4_ffacalc.kv    734             -- If we aren't the mode-exiting ']', print current symbol:
ffa_ch4_ffacalc.kv    735             if QuoteLevel > 0 then
ffa_ch4_ffacalc.kv    736                Write_Char(C);
ffa_ch4_ffacalc.kv    737             end if;
ffa_ch4_ffacalc.kv    738             
ffa_ch4_ffacalc.kv    739             --- ... in a ~taken~ Conditional branch:
ffa_ch4_ffacalc.kv    740          elsif CondLevel > 0 then
ffa_ch4_ffacalc.kv    741             case C is
ffa_ch4_ffacalc.kv    742                when '}' =>   -- Drop a nesting level:
ffa_ch4_ffacalc.kv    743                   CondLevel := CondLevel - 1;
ffa_ch4_ffacalc.kv    744                   
ffa_ch4_ffacalc.kv    745                   -- If we exited the Conditional as a result,
ffa_ch4_ffacalc.kv    746                   -- we push a 1 to trigger the possible 'else' clause:
ffa_ch4_ffacalc.kv    747                   if CondLevel = 0 then
ffa_ch4_ffacalc.kv    748                      Push;
ffa_ch11_tuning_a...  749                      FFA_WBool_To_FZ(1, Stack(SP));
ffa_ch4_ffacalc.kv    750                   end if;
ffa_ch4_ffacalc.kv    751                   
ffa_ch4_ffacalc.kv    752                when '{' =>   -- Add a nesting level:
ffa_ch4_ffacalc.kv    753                   CondLevel := CondLevel + 1;
ffa_ch4_ffacalc.kv    754                when others =>
ffa_ch4_ffacalc.kv    755                   null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv    756             end case;
ffa_ch13_measure_...  757             
ffa_ch13_measure_...  758             --- ... if in a prefixed op:
ffa_ch13_measure_...  759          elsif HavePrefix then
ffa_ch13_measure_...  760             
ffa_ch13_measure_...  761             -- Drop the prefix-op hammer, until another prefix-op cocks it
ffa_ch13_measure_...  762             HavePrefix := False;
ffa_ch13_measure_...  763             
ffa_ch13_measure_...  764             -- Dispatch this op, where prefix is the preceding character
ffa_ch13_measure_...  765             Op_Prefixed(Prefix => PrevC, O => C);
ffa_ch13_measure_...  766             
ffa_ch4_ffacalc.kv    767          else
ffa_ch4_ffacalc.kv    768             -- This is a Normal Op, so proceed with the normal rules.
ffa_ch4_ffacalc.kv    769             Op_Normal(C);
ffa_ch4_ffacalc.kv    770          end if;
ffa_ch4_ffacalc.kv    771          
ffa_ch4_ffacalc.kv    772       end Op;
ffa_ch4_ffacalc.kv    773       
ffa_ch4_ffacalc.kv    774       
ffa_ch4_ffacalc.kv    775       -- Current Character
ffa_ch4_ffacalc.kv    776       C : Character;
ffa_ch4_ffacalc.kv    777       
ffa_ch4_ffacalc.kv    778    begin
ffa_ch4_ffacalc.kv    779       -- Reset the Calculator      
ffa_ch4_ffacalc.kv    780       Zap;
ffa_ch4_ffacalc.kv    781       -- Process characters until EOF:
ffa_ch4_ffacalc.kv    782       loop
ffa_ch4_ffacalc.kv    783          if Read_Char(C) then
ffa_ch4_ffacalc.kv    784             -- Execute Op:
ffa_ch4_ffacalc.kv    785             Op(C);
ffa_ch4_ffacalc.kv    786             -- Advance Odometer
ffa_ch4_ffacalc.kv    787             Pos := Pos + 1;
ffa_ch13_measure_...  788             -- Save the op for use in prefixed ops
ffa_ch13_measure_...  789             PrevC := C;
ffa_ch4_ffacalc.kv    790          else
ffa_ch4_ffacalc.kv    791             Zap;
ffa_ch4_ffacalc.kv    792             Quit(0); -- if EOF, we're done
ffa_ch4_ffacalc.kv    793          end if;
ffa_ch4_ffacalc.kv    794       end loop;
ffa_ch4_ffacalc.kv    795    end;
ffa_ch4_ffacalc.kv    796    
ffa_ch4_ffacalc.kv    797 end FFA_Calc;