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