ffa_ch14_barrett.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_ch14_barrett.kv     5 -- (C) 2018 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_ch4_ffacalc.kv    396                -----------------
ffa_ch4_ffacalc.kv    397                -- Bitwise Ops --
ffa_ch4_ffacalc.kv    398                -----------------
ffa_ch4_ffacalc.kv    399                
ffa_ch4_ffacalc.kv    400                -- Bitwise-And
ffa_ch4_ffacalc.kv    401             when '&' =>
ffa_ch4_ffacalc.kv    402                Want(2);
ffa_ch11_tuning_a...  403                FFA_FZ_And(X      => Stack(SP - 1),
ffa_ch11_tuning_a...  404                           Y      => Stack(SP),
ffa_ch11_tuning_a...  405                           Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv    406                Drop;
ffa_ch4_ffacalc.kv    407                
ffa_ch4_ffacalc.kv    408                -- Bitwise-Or
ffa_ch4_ffacalc.kv    409             when '|' =>
ffa_ch4_ffacalc.kv    410                Want(2);
ffa_ch11_tuning_a...  411                FFA_FZ_Or(X      => Stack(SP - 1),
ffa_ch11_tuning_a...  412                          Y      => Stack(SP),
ffa_ch11_tuning_a...  413                          Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv    414                Drop;
ffa_ch4_ffacalc.kv    415                
ffa_ch4_ffacalc.kv    416                -- Bitwise-Xor
ffa_ch4_ffacalc.kv    417             when '^' =>
ffa_ch4_ffacalc.kv    418                Want(2);
ffa_ch11_tuning_a...  419                FFA_FZ_Xor(X      => Stack(SP - 1),
ffa_ch11_tuning_a...  420                           Y      => Stack(SP),
ffa_ch11_tuning_a...  421                           Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv    422                Drop;
ffa_ch4_ffacalc.kv    423                
ffa_ch4_ffacalc.kv    424                -- Bitwise-Not (1s-Complement)
ffa_ch4_ffacalc.kv    425             when '~' =>
ffa_ch4_ffacalc.kv    426                Want(1);
ffa_ch11_tuning_a...  427                FFA_FZ_Not(Stack(SP), Stack(SP));
ffa_ch4_ffacalc.kv    428                
ffa_ch4_ffacalc.kv    429                -----------
ffa_ch4_ffacalc.kv    430                -- Other --
ffa_ch4_ffacalc.kv    431                -----------
ffa_ch4_ffacalc.kv    432                
ffa_ch8_randomism.kv  433                -- Push a FZ of RNGolade onto the stack
ffa_ch8_randomism.kv  434             when '?' =>
ffa_ch8_randomism.kv  435                Push;
ffa_ch11_tuning_a...  436                FFA_FZ_Clear(Stack(SP));
ffa_ch8_randomism.kv  437                FZ_Random(RNG, Stack(SP));
ffa_ch8_randomism.kv  438                
ffa_ch4_ffacalc.kv    439                -- mUx
ffa_ch4_ffacalc.kv    440             when 'U' =>
ffa_ch4_ffacalc.kv    441                Want(3);
ffa_ch11_tuning_a...  442                FFA_FZ_Mux(X      => Stack(SP - 2),
ffa_ch11_tuning_a...  443                           Y      => Stack(SP - 1),
ffa_ch11_tuning_a...  444                           Result => Stack(SP - 2),
ffa_ch11_tuning_a...  445                           Sel    => FFA_FZ_NZeroP(Stack(SP)));
ffa_ch4_ffacalc.kv    446                Drop;
ffa_ch4_ffacalc.kv    447                Drop;
ffa_ch4_ffacalc.kv    448                
ffa_ch13_measure_...  449                -- Find the position of eldest nonzero bit, if any exist
ffa_ch13_measure_...  450             when 'W' =>
ffa_ch13_measure_...  451                Want(1);
ffa_ch13_measure_...  452                declare
ffa_ch13_measure_...  453                   -- Find the measure ( 0 if no 1s, or 1 .. FZBitness )
ffa_ch14_barrett.kv   454                   Measure : FZBit_Index := FFA_FZ_Measure(Stack(SP));
ffa_ch14_barrett.kv   455                begin
ffa_ch13_measure_...  456                   -- Put on top of stack
ffa_ch13_measure_...  457                   FFA_FZ_Clear(Stack(SP));
ffa_ch14_barrett.kv   458                   FFA_FZ_Set_Head(Stack(SP), Word(Measure));
ffa_ch13_measure_...  459                end;
ffa_ch13_measure_...  460                
ffa_ch4_ffacalc.kv    461                -- Put the Overflow flag on the stack
ffa_ch4_ffacalc.kv    462             when 'O' =>
ffa_ch4_ffacalc.kv    463                Push;
ffa_ch11_tuning_a...  464                FFA_WBool_To_FZ(Flag, Stack(SP));
ffa_ch4_ffacalc.kv    465                
ffa_ch4_ffacalc.kv    466                -- Print the FZ on the top of the stack
ffa_ch4_ffacalc.kv    467             when '#' =>
ffa_ch4_ffacalc.kv    468                Want(1);
ffa_ch11_tuning_a...  469                Print_FZ(Stack(SP));
ffa_ch4_ffacalc.kv    470                Drop;
ffa_ch4_ffacalc.kv    471                
ffa_ch4_ffacalc.kv    472                -- Zap (reset)
ffa_ch4_ffacalc.kv    473             when 'Z' =>
ffa_ch4_ffacalc.kv    474                Zap;
ffa_ch4_ffacalc.kv    475                
ffa_ch4_ffacalc.kv    476                -- Quit with Stack Trace
ffa_ch4_ffacalc.kv    477             when 'Q' =>
ffa_ch4_ffacalc.kv    478                for I in reverse Stack'First + 1 .. SP loop
ffa_ch11_tuning_a...  479                   Print_FZ(Stack(I));
ffa_ch4_ffacalc.kv    480                end loop;
ffa_ch4_ffacalc.kv    481                Quit(0);
ffa_ch4_ffacalc.kv    482                
ffa_ch14_barrett.kv   483                -- Put the FFACalc Program Version on the stack,
ffa_ch14_barrett.kv   484                -- followed by FFA Program Version.
ffa_ch14_barrett.kv   485             when 'V' =>
ffa_ch14_barrett.kv   486                Push;
ffa_ch14_barrett.kv   487                Push;
ffa_ch14_barrett.kv   488                -- FFACalc Version:
ffa_ch14_barrett.kv   489                FFA_FZ_Clear(Stack(SP - 1));
ffa_ch14_barrett.kv   490                FFA_FZ_Set_Head(Stack(SP - 1), Word(FFACalc_K_Version));
ffa_ch14_barrett.kv   491                -- FFA Version:
ffa_ch14_barrett.kv   492                FFA_FZ_Clear(Stack(SP));
ffa_ch14_barrett.kv   493                FFA_FZ_Set_Head(Stack(SP), Word(FFA_K_Version));
ffa_ch14_barrett.kv   494                
ffa_ch12_karatsub...  495                -- Square, give bottom and top halves
ffa_ch12_karatsub...  496             when 'S' =>
ffa_ch12_karatsub...  497                Want(1);
ffa_ch12_karatsub...  498                Push;
ffa_ch12_karatsub...  499                FFA_FZ_Square(X     => Stack(SP - 1),
ffa_ch12_karatsub...  500                              XX_Lo => Stack(SP - 1),
ffa_ch12_karatsub...  501                              XX_Hi => Stack(SP));
ffa_ch13_measure_...  502                
ffa_ch13_measure_...  503                --------------
ffa_ch13_measure_...  504                -- Prefixes --
ffa_ch13_measure_...  505                --------------
ffa_ch13_measure_...  506                
ffa_ch13_measure_...  507                -- 'Left...'    :
ffa_ch13_measure_...  508             when 'L' =>
ffa_ch13_measure_...  509                IsPrefix;
ffa_ch13_measure_...  510                
ffa_ch13_measure_...  511                -- 'Right...'   :
ffa_ch13_measure_...  512             when 'R' =>
ffa_ch13_measure_...  513                IsPrefix;
ffa_ch13_measure_...  514                
ffa_ch13_measure_...  515                -- 'Modular...' :
ffa_ch13_measure_...  516             when 'M' =>
ffa_ch13_measure_...  517                IsPrefix;
ffa_ch13_measure_...  518                
ffa_ch13_measure_...  519                ---------------------------------------------------------
ffa_ch13_measure_...  520                -- Reserved Ops, i.e. ones we have not defined yet:   --
ffa_ch13_measure_...  521                ---------------------------------------------------------
ffa_ch13_measure_...  522             when '!' | '@' | '$' | ':' | ';' | ',' |
ffa_ch13_measure_...  523                  'G' | 'H' | 'I' | 'J' | 'K' | 'N' |
ffa_ch14_barrett.kv   524                  'P' | 'T' | 'X' | 'Y' =>
ffa_ch13_measure_...  525                
ffa_ch13_measure_...  526                E("This Operator is not defined yet: " & C);
ffa_ch12_karatsub...  527                ---------------------------------------------------------
ffa_ch12_karatsub...  528                
ffa_ch4_ffacalc.kv    529                ----------
ffa_ch4_ffacalc.kv    530                -- NOPs --
ffa_ch4_ffacalc.kv    531                ----------
ffa_ch4_ffacalc.kv    532                
ffa_ch13_measure_...  533                -- Unprintables and spaces DO NOTHING:
ffa_ch4_ffacalc.kv    534             when others =>
ffa_ch4_ffacalc.kv    535                null;
ffa_ch4_ffacalc.kv    536                
ffa_ch4_ffacalc.kv    537          end case;
ffa_ch4_ffacalc.kv    538          
ffa_ch4_ffacalc.kv    539       end Op_Normal;
ffa_ch4_ffacalc.kv    540       
ffa_ch4_ffacalc.kv    541       
ffa_ch13_measure_...  542       -- Execute a Prefixed Op
ffa_ch13_measure_...  543       procedure Op_Prefixed(Prefix : in Character;
ffa_ch13_measure_...  544                             O      : in Character) is
ffa_ch13_measure_...  545       begin
ffa_ch13_measure_...  546          
ffa_ch13_measure_...  547          -- The Prefixed Op:
ffa_ch13_measure_...  548          case Prefix is
ffa_ch13_measure_...  549             
ffa_ch13_measure_...  550             ---------------------------------------------------------
ffa_ch13_measure_...  551             -- Left...
ffa_ch13_measure_...  552             when 'L' =>
ffa_ch13_measure_...  553                
ffa_ch13_measure_...  554                -- Which L-op?
ffa_ch13_measure_...  555                case O is
ffa_ch13_measure_...  556                   
ffa_ch13_measure_...  557                   -- ... Shift  :
ffa_ch13_measure_...  558                   when 'S' =>
ffa_ch13_measure_...  559                      Want(2);
ffa_ch13_measure_...  560                      declare
ffa_ch13_measure_...  561                         -- Number of bit positions to shift by:
ffa_ch13_measure_...  562                         ShiftCount : FZBit_Index
ffa_ch13_measure_...  563                           := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_...  564                      begin
ffa_ch13_measure_...  565                         FFA_FZ_Quiet_ShiftLeft(N        => Stack(SP - 1),
ffa_ch13_measure_...  566                                                ShiftedN => Stack(SP - 1),
ffa_ch13_measure_...  567                                                Count    => ShiftCount);
ffa_ch13_measure_...  568                      end;
ffa_ch13_measure_...  569                      Drop;
ffa_ch13_measure_...  570                      
ffa_ch13_measure_...  571                   -- ... Rotate :
ffa_ch13_measure_...  572                   when 'R' =>
ffa_ch13_measure_...  573                      E("Left-Rotate not yet defined!");
ffa_ch13_measure_...  574                      
ffa_ch13_measure_...  575                   -- ... Unknown:
ffa_ch13_measure_...  576                   when others =>
ffa_ch13_measure_...  577                      E("Undefined Op: L" & O);
ffa_ch13_measure_...  578                      
ffa_ch13_measure_...  579                end case;
ffa_ch13_measure_...  580             ---------------------------------------------------------
ffa_ch13_measure_...  581             -- Right...
ffa_ch13_measure_...  582             when 'R' =>
ffa_ch13_measure_...  583                
ffa_ch13_measure_...  584                -- Which R-op?
ffa_ch13_measure_...  585                case O is
ffa_ch13_measure_...  586                   
ffa_ch13_measure_...  587                   -- ... Shift:
ffa_ch13_measure_...  588                   when 'S' =>
ffa_ch13_measure_...  589                      Want(2);
ffa_ch13_measure_...  590                      declare
ffa_ch13_measure_...  591                         -- Number of bit positions to shift by:
ffa_ch13_measure_...  592                         ShiftCount : FZBit_Index
ffa_ch13_measure_...  593                           := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_...  594                      begin
ffa_ch13_measure_...  595                         FFA_FZ_Quiet_ShiftRight(N        => Stack(SP - 1),
ffa_ch13_measure_...  596                                                 ShiftedN => Stack(SP - 1),
ffa_ch13_measure_...  597                                                 Count    => ShiftCount);
ffa_ch13_measure_...  598                      end;
ffa_ch13_measure_...  599                      Drop;
ffa_ch13_measure_...  600                      
ffa_ch13_measure_...  601                   -- ... Rotate:
ffa_ch13_measure_...  602                   when 'R' =>
ffa_ch13_measure_...  603                      E("Right-Rotate not yet defined!");
ffa_ch13_measure_...  604                      
ffa_ch13_measure_...  605                   -- ... Unknown:
ffa_ch13_measure_...  606                   when others =>
ffa_ch13_measure_...  607                      E("Undefined Op: R" & O);
ffa_ch13_measure_...  608                      
ffa_ch13_measure_...  609                end case;
ffa_ch13_measure_...  610             ---------------------------------------------------------
ffa_ch13_measure_...  611             -- Modular...   
ffa_ch13_measure_...  612             when 'M' =>
ffa_ch13_measure_...  613                
ffa_ch13_measure_...  614                -- Which M-op?
ffa_ch13_measure_...  615                case O is
ffa_ch13_measure_...  616                   
ffa_ch13_measure_...  617                   -- ... Multiplication :
ffa_ch13_measure_...  618                   when '*' =>
ffa_ch13_measure_...  619                      Want(3);
ffa_ch13_measure_...  620                      MustNotZero(Stack(SP));
ffa_ch13_measure_...  621                      FFA_FZ_Modular_Multiply(X       => Stack(SP - 2),
ffa_ch13_measure_...  622                                              Y       => Stack(SP - 1),
ffa_ch13_measure_...  623                                              Modulus => Stack(SP),
ffa_ch13_measure_...  624                                              Product => Stack(SP - 2));
ffa_ch13_measure_...  625                      Drop;
ffa_ch13_measure_...  626                      Drop;
ffa_ch13_measure_...  627                      
ffa_ch13_measure_...  628                   -- ... Exponentiation :
ffa_ch13_measure_...  629                   when 'X' =>
ffa_ch13_measure_...  630                      Want(3);
ffa_ch13_measure_...  631                      MustNotZero(Stack(SP));
ffa_ch13_measure_...  632                      FFA_FZ_Modular_Exponentiate(Base     => Stack(SP - 2),
ffa_ch13_measure_...  633                                                  Exponent => Stack(SP - 1),
ffa_ch13_measure_...  634                                                  Modulus  => Stack(SP),
ffa_ch13_measure_...  635                                                  Result   => Stack(SP - 2));
ffa_ch13_measure_...  636                      Drop;
ffa_ch13_measure_...  637                      Drop;
ffa_ch13_measure_...  638                      
ffa_ch13_measure_...  639                   -- ... Unknown:
ffa_ch13_measure_...  640                   when others =>
ffa_ch13_measure_...  641                      E("Undefined Op: M" & O);
ffa_ch13_measure_...  642                      
ffa_ch13_measure_...  643                end case;
ffa_ch13_measure_...  644             ---------------------------------------------------------
ffa_ch13_measure_...  645             -- ... Unknown: (impossible per mechanics, but must handle case)
ffa_ch13_measure_...  646             when others =>
ffa_ch13_measure_...  647                E("Undefined Prefix: " & Prefix);
ffa_ch13_measure_...  648                
ffa_ch13_measure_...  649          end case;
ffa_ch13_measure_...  650          
ffa_ch13_measure_...  651       end Op_Prefixed;
ffa_ch13_measure_...  652       
ffa_ch13_measure_...  653       
ffa_ch4_ffacalc.kv    654       -- Process a Symbol
ffa_ch4_ffacalc.kv    655       procedure Op(C : in Character) is
ffa_ch4_ffacalc.kv    656       begin
ffa_ch4_ffacalc.kv    657          -- First, see whether we are in a state of nestedness:
ffa_ch4_ffacalc.kv    658          
ffa_ch4_ffacalc.kv    659          -- ... in a Comment block:
ffa_ch4_ffacalc.kv    660          if CommLevel > 0 then
ffa_ch4_ffacalc.kv    661             case C is
ffa_ch4_ffacalc.kv    662                when ')' =>  -- Drop a nesting level:
ffa_ch4_ffacalc.kv    663                   CommLevel := CommLevel - 1;
ffa_ch4_ffacalc.kv    664                when '(' =>  -- Add a nesting level:
ffa_ch4_ffacalc.kv    665                   CommLevel := CommLevel + 1;
ffa_ch4_ffacalc.kv    666                when others =>
ffa_ch4_ffacalc.kv    667                   null; -- Other symbols have no effect at all
ffa_ch4_ffacalc.kv    668             end case;
ffa_ch4_ffacalc.kv    669             
ffa_ch4_ffacalc.kv    670             -- ... in a Quote block:
ffa_ch4_ffacalc.kv    671          elsif QuoteLevel > 0 then
ffa_ch4_ffacalc.kv    672             case C is
ffa_ch4_ffacalc.kv    673                when ']' =>   -- Drop a nesting level:
ffa_ch4_ffacalc.kv    674                   QuoteLevel := QuoteLevel - 1;
ffa_ch4_ffacalc.kv    675                when '[' =>   -- Add a nesting level:
ffa_ch4_ffacalc.kv    676                   QuoteLevel := QuoteLevel + 1;
ffa_ch4_ffacalc.kv    677                when others =>
ffa_ch4_ffacalc.kv    678                   null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv    679             end case;
ffa_ch4_ffacalc.kv    680             
ffa_ch4_ffacalc.kv    681             -- If we aren't the mode-exiting ']', print current symbol:
ffa_ch4_ffacalc.kv    682             if QuoteLevel > 0 then
ffa_ch4_ffacalc.kv    683                Write_Char(C);
ffa_ch4_ffacalc.kv    684             end if;
ffa_ch4_ffacalc.kv    685             
ffa_ch4_ffacalc.kv    686             --- ... in a ~taken~ Conditional branch:
ffa_ch4_ffacalc.kv    687          elsif CondLevel > 0 then
ffa_ch4_ffacalc.kv    688             case C is
ffa_ch4_ffacalc.kv    689                when '}' =>   -- Drop a nesting level:
ffa_ch4_ffacalc.kv    690                   CondLevel := CondLevel - 1;
ffa_ch4_ffacalc.kv    691                   
ffa_ch4_ffacalc.kv    692                   -- If we exited the Conditional as a result,
ffa_ch4_ffacalc.kv    693                   -- we push a 1 to trigger the possible 'else' clause:
ffa_ch4_ffacalc.kv    694                   if CondLevel = 0 then
ffa_ch4_ffacalc.kv    695                      Push;
ffa_ch11_tuning_a...  696                      FFA_WBool_To_FZ(1, Stack(SP));
ffa_ch4_ffacalc.kv    697                   end if;
ffa_ch4_ffacalc.kv    698                   
ffa_ch4_ffacalc.kv    699                when '{' =>   -- Add a nesting level:
ffa_ch4_ffacalc.kv    700                   CondLevel := CondLevel + 1;
ffa_ch4_ffacalc.kv    701                when others =>
ffa_ch4_ffacalc.kv    702                   null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv    703             end case;
ffa_ch13_measure_...  704             
ffa_ch13_measure_...  705             --- ... if in a prefixed op:
ffa_ch13_measure_...  706          elsif HavePrefix then
ffa_ch13_measure_...  707             
ffa_ch13_measure_...  708             -- Drop the prefix-op hammer, until another prefix-op cocks it
ffa_ch13_measure_...  709             HavePrefix := False;
ffa_ch13_measure_...  710             
ffa_ch13_measure_...  711             -- Dispatch this op, where prefix is the preceding character
ffa_ch13_measure_...  712             Op_Prefixed(Prefix => PrevC, O => C);
ffa_ch13_measure_...  713             
ffa_ch4_ffacalc.kv    714          else
ffa_ch4_ffacalc.kv    715             -- This is a Normal Op, so proceed with the normal rules.
ffa_ch4_ffacalc.kv    716             Op_Normal(C);
ffa_ch4_ffacalc.kv    717          end if;
ffa_ch4_ffacalc.kv    718          
ffa_ch4_ffacalc.kv    719       end Op;
ffa_ch4_ffacalc.kv    720       
ffa_ch4_ffacalc.kv    721       
ffa_ch4_ffacalc.kv    722       -- Current Character
ffa_ch4_ffacalc.kv    723       C : Character;
ffa_ch4_ffacalc.kv    724       
ffa_ch4_ffacalc.kv    725    begin
ffa_ch4_ffacalc.kv    726       -- Reset the Calculator      
ffa_ch4_ffacalc.kv    727       Zap;
ffa_ch4_ffacalc.kv    728       -- Process characters until EOF:
ffa_ch4_ffacalc.kv    729       loop
ffa_ch4_ffacalc.kv    730          if Read_Char(C) then
ffa_ch4_ffacalc.kv    731             -- Execute Op:
ffa_ch4_ffacalc.kv    732             Op(C);
ffa_ch4_ffacalc.kv    733             -- Advance Odometer
ffa_ch4_ffacalc.kv    734             Pos := Pos + 1;
ffa_ch13_measure_...  735             -- Save the op for use in prefixed ops
ffa_ch13_measure_...  736             PrevC := C;
ffa_ch4_ffacalc.kv    737          else
ffa_ch4_ffacalc.kv    738             Zap;
ffa_ch4_ffacalc.kv    739             Quit(0); -- if EOF, we're done
ffa_ch4_ffacalc.kv    740          end if;
ffa_ch4_ffacalc.kv    741       end loop;
ffa_ch4_ffacalc.kv    742    end;
ffa_ch4_ffacalc.kv    743    
ffa_ch4_ffacalc.kv    744 end FFA_Calc;