ffa_ch15_gcd.kv

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_ch13_measure_...  516                --------------
ffa_ch13_measure_...  517                -- Prefixes --
ffa_ch13_measure_...  518                --------------
ffa_ch13_measure_...  519                
ffa_ch13_measure_...  520                -- 'Left...'    :
ffa_ch13_measure_...  521             when 'L' =>
ffa_ch13_measure_...  522                IsPrefix;
ffa_ch13_measure_...  523                
ffa_ch13_measure_...  524                -- 'Right...'   :
ffa_ch13_measure_...  525             when 'R' =>
ffa_ch13_measure_...  526                IsPrefix;
ffa_ch13_measure_...  527                
ffa_ch13_measure_...  528                -- 'Modular...' :
ffa_ch13_measure_...  529             when 'M' =>
ffa_ch13_measure_...  530                IsPrefix;
ffa_ch13_measure_...  531                
ffa_ch13_measure_...  532                ---------------------------------------------------------
ffa_ch13_measure_...  533                -- Reserved Ops, i.e. ones we have not defined yet:   --
ffa_ch13_measure_...  534                ---------------------------------------------------------
ffa_ch13_measure_...  535             when '!' | '@' | '$' | ':' | ';' | ',' |
ffa_ch15_gcd.kv       536                  'H' | 'I' | 'J' | 'K' | 'N' |
ffa_ch14_barrett.kv   537                  'P' | 'T' | 'X' | 'Y' =>
ffa_ch13_measure_...  538                
ffa_ch13_measure_...  539                E("This Operator is not defined yet: " & C);
ffa_ch12_karatsub...  540                ---------------------------------------------------------
ffa_ch12_karatsub...  541                
ffa_ch4_ffacalc.kv    542                ----------
ffa_ch4_ffacalc.kv    543                -- NOPs --
ffa_ch4_ffacalc.kv    544                ----------
ffa_ch4_ffacalc.kv    545                
ffa_ch13_measure_...  546                -- Unprintables and spaces DO NOTHING:
ffa_ch4_ffacalc.kv    547             when others =>
ffa_ch4_ffacalc.kv    548                null;
ffa_ch4_ffacalc.kv    549                
ffa_ch4_ffacalc.kv    550          end case;
ffa_ch4_ffacalc.kv    551          
ffa_ch4_ffacalc.kv    552       end Op_Normal;
ffa_ch4_ffacalc.kv    553       
ffa_ch4_ffacalc.kv    554       
ffa_ch13_measure_...  555       -- Execute a Prefixed Op
ffa_ch13_measure_...  556       procedure Op_Prefixed(Prefix : in Character;
ffa_ch13_measure_...  557                             O      : in Character) is
ffa_ch13_measure_...  558       begin
ffa_ch13_measure_...  559          
ffa_ch13_measure_...  560          -- The Prefixed Op:
ffa_ch13_measure_...  561          case Prefix is
ffa_ch13_measure_...  562             
ffa_ch13_measure_...  563             ---------------------------------------------------------
ffa_ch13_measure_...  564             -- Left...
ffa_ch13_measure_...  565             when 'L' =>
ffa_ch13_measure_...  566                
ffa_ch13_measure_...  567                -- Which L-op?
ffa_ch13_measure_...  568                case O is
ffa_ch13_measure_...  569                   
ffa_ch13_measure_...  570                   -- ... Shift  :
ffa_ch13_measure_...  571                   when 'S' =>
ffa_ch13_measure_...  572                      Want(2);
ffa_ch13_measure_...  573                      declare
ffa_ch13_measure_...  574                         -- Number of bit positions to shift by:
ffa_ch13_measure_...  575                         ShiftCount : FZBit_Index
ffa_ch13_measure_...  576                           := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_...  577                      begin
ffa_ch13_measure_...  578                         FFA_FZ_Quiet_ShiftLeft(N        => Stack(SP - 1),
ffa_ch13_measure_...  579                                                ShiftedN => Stack(SP - 1),
ffa_ch13_measure_...  580                                                Count    => ShiftCount);
ffa_ch13_measure_...  581                      end;
ffa_ch13_measure_...  582                      Drop;
ffa_ch13_measure_...  583                      
ffa_ch13_measure_...  584                   -- ... Rotate :
ffa_ch13_measure_...  585                   when 'R' =>
ffa_ch13_measure_...  586                      E("Left-Rotate not yet defined!");
ffa_ch13_measure_...  587                      
ffa_ch13_measure_...  588                   -- ... Unknown:
ffa_ch13_measure_...  589                   when others =>
ffa_ch13_measure_...  590                      E("Undefined Op: L" & O);
ffa_ch13_measure_...  591                      
ffa_ch13_measure_...  592                end case;
ffa_ch13_measure_...  593             ---------------------------------------------------------
ffa_ch13_measure_...  594             -- Right...
ffa_ch13_measure_...  595             when 'R' =>
ffa_ch13_measure_...  596                
ffa_ch13_measure_...  597                -- Which R-op?
ffa_ch13_measure_...  598                case O is
ffa_ch13_measure_...  599                   
ffa_ch13_measure_...  600                   -- ... Shift:
ffa_ch13_measure_...  601                   when 'S' =>
ffa_ch13_measure_...  602                      Want(2);
ffa_ch13_measure_...  603                      declare
ffa_ch13_measure_...  604                         -- Number of bit positions to shift by:
ffa_ch13_measure_...  605                         ShiftCount : FZBit_Index
ffa_ch13_measure_...  606                           := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_...  607                      begin
ffa_ch13_measure_...  608                         FFA_FZ_Quiet_ShiftRight(N        => Stack(SP - 1),
ffa_ch13_measure_...  609                                                 ShiftedN => Stack(SP - 1),
ffa_ch13_measure_...  610                                                 Count    => ShiftCount);
ffa_ch13_measure_...  611                      end;
ffa_ch13_measure_...  612                      Drop;
ffa_ch13_measure_...  613                      
ffa_ch13_measure_...  614                   -- ... Rotate:
ffa_ch13_measure_...  615                   when 'R' =>
ffa_ch13_measure_...  616                      E("Right-Rotate not yet defined!");
ffa_ch13_measure_...  617                      
ffa_ch15_gcd.kv       618                   -- 'Right-Multiply', give only lower half of the product XY
ffa_ch15_gcd.kv       619                   when '*' =>
ffa_ch15_gcd.kv       620                      Want(2);
ffa_ch15_gcd.kv       621                      FFA_FZ_Low_Multiply(X  => Stack(SP - 1),
ffa_ch15_gcd.kv       622                                          Y  => Stack(SP),
ffa_ch15_gcd.kv       623                                          XY => Stack(SP - 1));
ffa_ch15_gcd.kv       624                      Drop;
ffa_ch15_gcd.kv       625                      
ffa_ch13_measure_...  626                   -- ... Unknown:
ffa_ch13_measure_...  627                   when others =>
ffa_ch13_measure_...  628                      E("Undefined Op: R" & O);
ffa_ch13_measure_...  629                      
ffa_ch13_measure_...  630                end case;
ffa_ch13_measure_...  631             ---------------------------------------------------------
ffa_ch15_gcd.kv       632             -- Modular...
ffa_ch13_measure_...  633             when 'M' =>
ffa_ch13_measure_...  634                
ffa_ch13_measure_...  635                -- Which M-op?
ffa_ch13_measure_...  636                case O is
ffa_ch13_measure_...  637                   
ffa_ch15_gcd.kv       638                   -- ... Multiplication (Conventional) :
ffa_ch13_measure_...  639                   when '*' =>
ffa_ch13_measure_...  640                      Want(3);
ffa_ch13_measure_...  641                      MustNotZero(Stack(SP));
ffa_ch13_measure_...  642                      FFA_FZ_Modular_Multiply(X       => Stack(SP - 2),
ffa_ch13_measure_...  643                                              Y       => Stack(SP - 1),
ffa_ch13_measure_...  644                                              Modulus => Stack(SP),
ffa_ch13_measure_...  645                                              Product => Stack(SP - 2));
ffa_ch13_measure_...  646                      Drop;
ffa_ch13_measure_...  647                      Drop;
ffa_ch13_measure_...  648                      
ffa_ch15_gcd.kv       649                   -- ... Squaring (Conventional) :
ffa_ch15_gcd.kv       650                   when 'S' =>
ffa_ch15_gcd.kv       651                      Want(2);
ffa_ch15_gcd.kv       652                      MustNotZero(Stack(SP));
ffa_ch15_gcd.kv       653                      FFA_FZ_Modular_Square(X       => Stack(SP - 1),
ffa_ch15_gcd.kv       654                                            Modulus => Stack(SP),
ffa_ch15_gcd.kv       655                                            Product => Stack(SP - 1));
ffa_ch15_gcd.kv       656                      Drop;
ffa_ch15_gcd.kv       657                      
ffa_ch15_gcd.kv       658                   -- ... Exponentiation (Barrettronic) :
ffa_ch13_measure_...  659                   when 'X' =>
ffa_ch13_measure_...  660                      Want(3);
ffa_ch13_measure_...  661                      MustNotZero(Stack(SP));
ffa_ch13_measure_...  662                      FFA_FZ_Modular_Exponentiate(Base     => Stack(SP - 2),
ffa_ch13_measure_...  663                                                  Exponent => Stack(SP - 1),
ffa_ch13_measure_...  664                                                  Modulus  => Stack(SP),
ffa_ch13_measure_...  665                                                  Result   => Stack(SP - 2));
ffa_ch13_measure_...  666                      Drop;
ffa_ch13_measure_...  667                      Drop;
ffa_ch13_measure_...  668                      
ffa_ch13_measure_...  669                   -- ... Unknown:
ffa_ch13_measure_...  670                   when others =>
ffa_ch13_measure_...  671                      E("Undefined Op: M" & O);
ffa_ch13_measure_...  672                      
ffa_ch13_measure_...  673                end case;
ffa_ch13_measure_...  674             ---------------------------------------------------------
ffa_ch13_measure_...  675             -- ... Unknown: (impossible per mechanics, but must handle case)
ffa_ch13_measure_...  676             when others =>
ffa_ch13_measure_...  677                E("Undefined Prefix: " & Prefix);
ffa_ch13_measure_...  678                
ffa_ch13_measure_...  679          end case;
ffa_ch13_measure_...  680          
ffa_ch13_measure_...  681       end Op_Prefixed;
ffa_ch13_measure_...  682       
ffa_ch13_measure_...  683       
ffa_ch4_ffacalc.kv    684       -- Process a Symbol
ffa_ch4_ffacalc.kv    685       procedure Op(C : in Character) is
ffa_ch4_ffacalc.kv    686       begin
ffa_ch4_ffacalc.kv    687          -- First, see whether we are in a state of nestedness:
ffa_ch4_ffacalc.kv    688          
ffa_ch4_ffacalc.kv    689          -- ... in a Comment block:
ffa_ch4_ffacalc.kv    690          if CommLevel > 0 then
ffa_ch4_ffacalc.kv    691             case C is
ffa_ch4_ffacalc.kv    692                when ')' =>  -- Drop a nesting level:
ffa_ch4_ffacalc.kv    693                   CommLevel := CommLevel - 1;
ffa_ch4_ffacalc.kv    694                when '(' =>  -- Add a nesting level:
ffa_ch4_ffacalc.kv    695                   CommLevel := CommLevel + 1;
ffa_ch4_ffacalc.kv    696                when others =>
ffa_ch4_ffacalc.kv    697                   null; -- Other symbols have no effect at all
ffa_ch4_ffacalc.kv    698             end case;
ffa_ch4_ffacalc.kv    699             
ffa_ch4_ffacalc.kv    700             -- ... in a Quote block:
ffa_ch4_ffacalc.kv    701          elsif QuoteLevel > 0 then
ffa_ch4_ffacalc.kv    702             case C is
ffa_ch4_ffacalc.kv    703                when ']' =>   -- Drop a nesting level:
ffa_ch4_ffacalc.kv    704                   QuoteLevel := QuoteLevel - 1;
ffa_ch4_ffacalc.kv    705                when '[' =>   -- Add a nesting level:
ffa_ch4_ffacalc.kv    706                   QuoteLevel := QuoteLevel + 1;
ffa_ch4_ffacalc.kv    707                when others =>
ffa_ch4_ffacalc.kv    708                   null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv    709             end case;
ffa_ch4_ffacalc.kv    710             
ffa_ch4_ffacalc.kv    711             -- If we aren't the mode-exiting ']', print current symbol:
ffa_ch4_ffacalc.kv    712             if QuoteLevel > 0 then
ffa_ch4_ffacalc.kv    713                Write_Char(C);
ffa_ch4_ffacalc.kv    714             end if;
ffa_ch4_ffacalc.kv    715             
ffa_ch4_ffacalc.kv    716             --- ... in a ~taken~ Conditional branch:
ffa_ch4_ffacalc.kv    717          elsif CondLevel > 0 then
ffa_ch4_ffacalc.kv    718             case C is
ffa_ch4_ffacalc.kv    719                when '}' =>   -- Drop a nesting level:
ffa_ch4_ffacalc.kv    720                   CondLevel := CondLevel - 1;
ffa_ch4_ffacalc.kv    721                   
ffa_ch4_ffacalc.kv    722                   -- If we exited the Conditional as a result,
ffa_ch4_ffacalc.kv    723                   -- we push a 1 to trigger the possible 'else' clause:
ffa_ch4_ffacalc.kv    724                   if CondLevel = 0 then
ffa_ch4_ffacalc.kv    725                      Push;
ffa_ch11_tuning_a...  726                      FFA_WBool_To_FZ(1, Stack(SP));
ffa_ch4_ffacalc.kv    727                   end if;
ffa_ch4_ffacalc.kv    728                   
ffa_ch4_ffacalc.kv    729                when '{' =>   -- Add a nesting level:
ffa_ch4_ffacalc.kv    730                   CondLevel := CondLevel + 1;
ffa_ch4_ffacalc.kv    731                when others =>
ffa_ch4_ffacalc.kv    732                   null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv    733             end case;
ffa_ch13_measure_...  734             
ffa_ch13_measure_...  735             --- ... if in a prefixed op:
ffa_ch13_measure_...  736          elsif HavePrefix then
ffa_ch13_measure_...  737             
ffa_ch13_measure_...  738             -- Drop the prefix-op hammer, until another prefix-op cocks it
ffa_ch13_measure_...  739             HavePrefix := False;
ffa_ch13_measure_...  740             
ffa_ch13_measure_...  741             -- Dispatch this op, where prefix is the preceding character
ffa_ch13_measure_...  742             Op_Prefixed(Prefix => PrevC, O => C);
ffa_ch13_measure_...  743             
ffa_ch4_ffacalc.kv    744          else
ffa_ch4_ffacalc.kv    745             -- This is a Normal Op, so proceed with the normal rules.
ffa_ch4_ffacalc.kv    746             Op_Normal(C);
ffa_ch4_ffacalc.kv    747          end if;
ffa_ch4_ffacalc.kv    748          
ffa_ch4_ffacalc.kv    749       end Op;
ffa_ch4_ffacalc.kv    750       
ffa_ch4_ffacalc.kv    751       
ffa_ch4_ffacalc.kv    752       -- Current Character
ffa_ch4_ffacalc.kv    753       C : Character;
ffa_ch4_ffacalc.kv    754       
ffa_ch4_ffacalc.kv    755    begin
ffa_ch4_ffacalc.kv    756       -- Reset the Calculator      
ffa_ch4_ffacalc.kv    757       Zap;
ffa_ch4_ffacalc.kv    758       -- Process characters until EOF:
ffa_ch4_ffacalc.kv    759       loop
ffa_ch4_ffacalc.kv    760          if Read_Char(C) then
ffa_ch4_ffacalc.kv    761             -- Execute Op:
ffa_ch4_ffacalc.kv    762             Op(C);
ffa_ch4_ffacalc.kv    763             -- Advance Odometer
ffa_ch4_ffacalc.kv    764             Pos := Pos + 1;
ffa_ch13_measure_...  765             -- Save the op for use in prefixed ops
ffa_ch13_measure_...  766             PrevC := C;
ffa_ch4_ffacalc.kv    767          else
ffa_ch4_ffacalc.kv    768             Zap;
ffa_ch4_ffacalc.kv    769             Quit(0); -- if EOF, we're done
ffa_ch4_ffacalc.kv    770          end if;
ffa_ch4_ffacalc.kv    771       end loop;
ffa_ch4_ffacalc.kv    772    end;
ffa_ch4_ffacalc.kv    773    
ffa_ch4_ffacalc.kv    774 end FFA_Calc;