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_ch9_exodus.kv 383 -- Ch9: Comba's algorithm
ffa_ch9_exodus.kv 384 FZ_Mul_Comba(X => Stack(SP - 1),
ffa_ch9_exodus.kv 385 Y => Stack(SP),
ffa_ch9_exodus.kv 386 XY_Lo => Stack(SP - 1),
ffa_ch9_exodus.kv 387 XY_Hi => Stack(SP));
ffa_ch5_egypt.kv 388
ffa_ch6_simplest_... 389 -- Modular Multiplication
ffa_ch6_simplest_... 390 when 'M' =>
ffa_ch6_simplest_... 391 Want(3);
ffa_ch6_simplest_... 392 MustNotZero(Stack(SP));
ffa_ch6_simplest_... 393 FZ_Mod_Mul(X => Stack(SP - 2),
ffa_ch6_simplest_... 394 Y => Stack(SP - 1),
ffa_ch6_simplest_... 395 Modulus => Stack(SP),
ffa_ch6_simplest_... 396 Product => Stack(SP - 2));
ffa_ch6_simplest_... 397 Drop;
ffa_ch6_simplest_... 398 Drop;
ffa_ch6_simplest_... 399
ffa_ch6_simplest_... 400 -- Modular Exponentiation
ffa_ch6_simplest_... 401 when 'X' =>
ffa_ch6_simplest_... 402 Want(3);
ffa_ch6_simplest_... 403 MustNotZero(Stack(SP));
ffa_ch6_simplest_... 404 FZ_Mod_Exp(Base => Stack(SP - 2),
ffa_ch6_simplest_... 405 Exponent => Stack(SP - 1),
ffa_ch6_simplest_... 406 Modulus => Stack(SP),
ffa_ch6_simplest_... 407 Result => Stack(SP - 2));
ffa_ch6_simplest_... 408 Drop;
ffa_ch6_simplest_... 409 Drop;
ffa_ch6_simplest_... 410
ffa_ch4_ffacalc.kv 411 -----------------
ffa_ch4_ffacalc.kv 412 -- Bitwise Ops --
ffa_ch4_ffacalc.kv 413 -----------------
ffa_ch4_ffacalc.kv 414
ffa_ch4_ffacalc.kv 415 -- Bitwise-And
ffa_ch4_ffacalc.kv 416 when '&' =>
ffa_ch4_ffacalc.kv 417 Want(2);
ffa_ch4_ffacalc.kv 418 FZ_And(X => Stack(SP - 1),
ffa_ch4_ffacalc.kv 419 Y => Stack(SP),
ffa_ch4_ffacalc.kv 420 Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv 421 Drop;
ffa_ch4_ffacalc.kv 422
ffa_ch4_ffacalc.kv 423 -- Bitwise-Or
ffa_ch4_ffacalc.kv 424 when '|' =>
ffa_ch4_ffacalc.kv 425 Want(2);
ffa_ch4_ffacalc.kv 426 FZ_Or(X => Stack(SP - 1),
ffa_ch4_ffacalc.kv 427 Y => Stack(SP),
ffa_ch4_ffacalc.kv 428 Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv 429 Drop;
ffa_ch4_ffacalc.kv 430
ffa_ch4_ffacalc.kv 431 -- Bitwise-Xor
ffa_ch4_ffacalc.kv 432 when '^' =>
ffa_ch4_ffacalc.kv 433 Want(2);
ffa_ch4_ffacalc.kv 434 FZ_Xor(X => Stack(SP - 1),
ffa_ch4_ffacalc.kv 435 Y => Stack(SP),
ffa_ch4_ffacalc.kv 436 Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv 437 Drop;
ffa_ch4_ffacalc.kv 438
ffa_ch4_ffacalc.kv 439 -- Bitwise-Not (1s-Complement)
ffa_ch4_ffacalc.kv 440 when '~' =>
ffa_ch4_ffacalc.kv 441 Want(1);
ffa_ch4_ffacalc.kv 442 FZ_Not(Stack(SP), Stack(SP));
ffa_ch4_ffacalc.kv 443
ffa_ch4_ffacalc.kv 444 -----------
ffa_ch4_ffacalc.kv 445 -- Other --
ffa_ch4_ffacalc.kv 446 -----------
ffa_ch4_ffacalc.kv 447
ffa_ch8_randomism.kv 448 -- Push a FZ of RNGolade onto the stack
ffa_ch8_randomism.kv 449 when '?' =>
ffa_ch8_randomism.kv 450 Push;
ffa_ch8_randomism.kv 451 FZ_Clear(Stack(SP));
ffa_ch8_randomism.kv 452 FZ_Random(RNG, Stack(SP));
ffa_ch8_randomism.kv 453
ffa_ch4_ffacalc.kv 454 -- mUx
ffa_ch4_ffacalc.kv 455 when 'U' =>
ffa_ch4_ffacalc.kv 456 Want(3);
ffa_ch4_ffacalc.kv 457 FZ_Mux(X => Stack(SP - 2),
ffa_ch4_ffacalc.kv 458 Y => Stack(SP - 1),
ffa_ch4_ffacalc.kv 459 Result => Stack(SP - 2),
ffa_ch4_ffacalc.kv 460 Sel => FZ_NZeroP(Stack(SP)));
ffa_ch4_ffacalc.kv 461 Drop;
ffa_ch4_ffacalc.kv 462 Drop;
ffa_ch4_ffacalc.kv 463
ffa_ch4_ffacalc.kv 464 -- Put the Overflow flag on the stack
ffa_ch4_ffacalc.kv 465 when 'O' =>
ffa_ch4_ffacalc.kv 466 Push;
ffa_ch4_ffacalc.kv 467 WBool_To_FZ(Flag, Stack(SP));
ffa_ch4_ffacalc.kv 468
ffa_ch4_ffacalc.kv 469 -- Print the FZ on the top of the stack
ffa_ch4_ffacalc.kv 470 when '#' =>
ffa_ch4_ffacalc.kv 471 Want(1);
ffa_ch4_ffacalc.kv 472 Dump(Stack(SP));
ffa_ch4_ffacalc.kv 473 Drop;
ffa_ch4_ffacalc.kv 474
ffa_ch4_ffacalc.kv 475 -- Zap (reset)
ffa_ch4_ffacalc.kv 476 when 'Z' =>
ffa_ch4_ffacalc.kv 477 Zap;
ffa_ch4_ffacalc.kv 478
ffa_ch4_ffacalc.kv 479 -- Quit with Stack Trace
ffa_ch4_ffacalc.kv 480 when 'Q' =>
ffa_ch4_ffacalc.kv 481 for I in reverse Stack'First + 1 .. SP loop
ffa_ch4_ffacalc.kv 482 Dump(Stack(I));
ffa_ch4_ffacalc.kv 483 end loop;
ffa_ch4_ffacalc.kv 484 Quit(0);
ffa_ch4_ffacalc.kv 485
ffa_ch4_ffacalc.kv 486 ----------
ffa_ch4_ffacalc.kv 487 -- NOPs --
ffa_ch4_ffacalc.kv 488 ----------
ffa_ch4_ffacalc.kv 489
ffa_ch4_ffacalc.kv 490 -- Ops we have not yet spoken of -- do nothing
ffa_ch4_ffacalc.kv 491 when others =>
ffa_ch4_ffacalc.kv 492 null;
ffa_ch4_ffacalc.kv 493
ffa_ch4_ffacalc.kv 494 end case;
ffa_ch4_ffacalc.kv 495
ffa_ch4_ffacalc.kv 496 end Op_Normal;
ffa_ch4_ffacalc.kv 497
ffa_ch4_ffacalc.kv 498
ffa_ch4_ffacalc.kv 499 -- Process a Symbol
ffa_ch4_ffacalc.kv 500 procedure Op(C : in Character) is
ffa_ch4_ffacalc.kv 501 begin
ffa_ch4_ffacalc.kv 502 -- First, see whether we are in a state of nestedness:
ffa_ch4_ffacalc.kv 503
ffa_ch4_ffacalc.kv 504 -- ... in a Comment block:
ffa_ch4_ffacalc.kv 505 if CommLevel > 0 then
ffa_ch4_ffacalc.kv 506 case C is
ffa_ch4_ffacalc.kv 507 when ')' => -- Drop a nesting level:
ffa_ch4_ffacalc.kv 508 CommLevel := CommLevel - 1;
ffa_ch4_ffacalc.kv 509 when '(' => -- Add a nesting level:
ffa_ch4_ffacalc.kv 510 CommLevel := CommLevel + 1;
ffa_ch4_ffacalc.kv 511 when others =>
ffa_ch4_ffacalc.kv 512 null; -- Other symbols have no effect at all
ffa_ch4_ffacalc.kv 513 end case;
ffa_ch4_ffacalc.kv 514
ffa_ch4_ffacalc.kv 515 -- ... in a Quote block:
ffa_ch4_ffacalc.kv 516 elsif QuoteLevel > 0 then
ffa_ch4_ffacalc.kv 517 case C is
ffa_ch4_ffacalc.kv 518 when ']' => -- Drop a nesting level:
ffa_ch4_ffacalc.kv 519 QuoteLevel := QuoteLevel - 1;
ffa_ch4_ffacalc.kv 520 when '[' => -- Add a nesting level:
ffa_ch4_ffacalc.kv 521 QuoteLevel := QuoteLevel + 1;
ffa_ch4_ffacalc.kv 522 when others =>
ffa_ch4_ffacalc.kv 523 null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv 524 end case;
ffa_ch4_ffacalc.kv 525
ffa_ch4_ffacalc.kv 526 -- If we aren't the mode-exiting ']', print current symbol:
ffa_ch4_ffacalc.kv 527 if QuoteLevel > 0 then
ffa_ch4_ffacalc.kv 528 Write_Char(C);
ffa_ch4_ffacalc.kv 529 end if;
ffa_ch4_ffacalc.kv 530
ffa_ch4_ffacalc.kv 531 --- ... in a ~taken~ Conditional branch:
ffa_ch4_ffacalc.kv 532 elsif CondLevel > 0 then
ffa_ch4_ffacalc.kv 533 case C is
ffa_ch4_ffacalc.kv 534 when '}' => -- Drop a nesting level:
ffa_ch4_ffacalc.kv 535 CondLevel := CondLevel - 1;
ffa_ch4_ffacalc.kv 536
ffa_ch4_ffacalc.kv 537 -- If we exited the Conditional as a result,
ffa_ch4_ffacalc.kv 538 -- we push a 1 to trigger the possible 'else' clause:
ffa_ch4_ffacalc.kv 539 if CondLevel = 0 then
ffa_ch4_ffacalc.kv 540 Push;
ffa_ch4_ffacalc.kv 541 WBool_To_FZ(1, Stack(SP));
ffa_ch4_ffacalc.kv 542 end if;
ffa_ch4_ffacalc.kv 543
ffa_ch4_ffacalc.kv 544 when '{' => -- Add a nesting level:
ffa_ch4_ffacalc.kv 545 CondLevel := CondLevel + 1;
ffa_ch4_ffacalc.kv 546 when others =>
ffa_ch4_ffacalc.kv 547 null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv 548 end case;
ffa_ch4_ffacalc.kv 549 else
ffa_ch4_ffacalc.kv 550 -- This is a Normal Op, so proceed with the normal rules.
ffa_ch4_ffacalc.kv 551 Op_Normal(C);
ffa_ch4_ffacalc.kv 552 end if;
ffa_ch4_ffacalc.kv 553
ffa_ch4_ffacalc.kv 554 end Op;
ffa_ch4_ffacalc.kv 555
ffa_ch4_ffacalc.kv 556
ffa_ch4_ffacalc.kv 557 -- Current Character
ffa_ch4_ffacalc.kv 558 C : Character;
ffa_ch4_ffacalc.kv 559
ffa_ch4_ffacalc.kv 560 begin
ffa_ch4_ffacalc.kv 561 -- Reset the Calculator
ffa_ch4_ffacalc.kv 562 Zap;
ffa_ch4_ffacalc.kv 563 -- Process characters until EOF:
ffa_ch4_ffacalc.kv 564 loop
ffa_ch4_ffacalc.kv 565 if Read_Char(C) then
ffa_ch4_ffacalc.kv 566 -- Execute Op:
ffa_ch4_ffacalc.kv 567 Op(C);
ffa_ch4_ffacalc.kv 568 -- Advance Odometer
ffa_ch4_ffacalc.kv 569 Pos := Pos + 1;
ffa_ch4_ffacalc.kv 570 else
ffa_ch4_ffacalc.kv 571 Zap;
ffa_ch4_ffacalc.kv 572 Quit(0); -- if EOF, we're done
ffa_ch4_ffacalc.kv 573 end if;
ffa_ch4_ffacalc.kv 574 end loop;
ffa_ch4_ffacalc.kv 575 end;
ffa_ch4_ffacalc.kv 576
ffa_ch4_ffacalc.kv 577 end FFA_Calc;