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