raw
ffa_ch4_ffacalc.kv      1 ------------------------------------------------------------------------------
ffa_ch4_ffacalc.kv 2 ------------------------------------------------------------------------------
ffa_ch4_ffacalc.kv 3 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
ffa_ch4_ffacalc.kv 4 -- --
ffa_ch15_gcd.kv 5 -- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org ) --
ffa_ch4_ffacalc.kv 6 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
ffa_ch4_ffacalc.kv 7 -- --
ffa_ch4_ffacalc.kv 8 -- You do not have, nor can you ever acquire the right to use, copy or --
ffa_ch4_ffacalc.kv 9 -- distribute this software ; Should you use this software for any purpose, --
ffa_ch4_ffacalc.kv 10 -- or copy and distribute it to anyone or in any manner, you are breaking --
ffa_ch4_ffacalc.kv 11 -- the laws of whatever soi-disant jurisdiction, and you promise to --
ffa_ch4_ffacalc.kv 12 -- continue doing so for the indefinite future. In any case, please --
ffa_ch4_ffacalc.kv 13 -- always : read and understand any software ; verify any PGP signatures --
ffa_ch4_ffacalc.kv 14 -- that you use - for any purpose. --
ffa_ch4_ffacalc.kv 15 -- --
ffa_ch4_ffacalc.kv 16 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
ffa_ch4_ffacalc.kv 17 ------------------------------------------------------------------------------
ffa_ch4_ffacalc.kv 18 ------------------------------------------------------------------------------
ffa_ch4_ffacalc.kv 19
ffa_ch4_ffacalc.kv 20 -- Basics
ffa_ch14_barrett.kv 21 with Version; use Version;
ffa_ch8_randomism.kv 22 with OS; use OS;
ffa_ch8_randomism.kv 23 with CmdLine; use CmdLine;
ffa_ch4_ffacalc.kv 24
ffa_ch4_ffacalc.kv 25 -- FFA
ffa_ch11_tuning_a... 26 with FFA; use FFA;
ffa_ch4_ffacalc.kv 27
ffa_ch11_tuning_a... 28 -- For the intrinsic equality operator on Words
ffa_ch11_tuning_a... 29 use type FFA.Word;
ffa_ch4_ffacalc.kv 30
ffa_ch8_randomism.kv 31 -- For RNG:
ffa_ch8_randomism.kv 32 with FFA_RNG; use FFA_RNG;
ffa_ch8_randomism.kv 33
ffa_ch8_randomism.kv 34
ffa_ch4_ffacalc.kv 35 procedure FFA_Calc is
ffa_ch4_ffacalc.kv 36
ffa_ch14_barrett.kv 37 Width : Positive; -- Desired FFA Width
ffa_ch14_barrett.kv 38 Height : Positive; -- Desired Height of Stack
ffa_ch14_barrett.kv 39 RNG : RNG_Device; -- The active RNG device.
ffa_ch4_ffacalc.kv 40
ffa_ch4_ffacalc.kv 41 begin
ffa_ch8_randomism.kv 42 if Arg_Count < 3 or Arg_Count > 4 then
ffa_ch8_randomism.kv 43 Eggog("Usage: ./ffa_calc WIDTH HEIGHT [/dev/rng]");
ffa_ch4_ffacalc.kv 44 end if;
ffa_ch4_ffacalc.kv 45
ffa_ch4_ffacalc.kv 46 declare
ffa_ch4_ffacalc.kv 47 Arg1 : CmdLineArg;
ffa_ch4_ffacalc.kv 48 Arg2 : CmdLineArg;
ffa_ch4_ffacalc.kv 49 begin
ffa_ch4_ffacalc.kv 50 -- Get commandline args:
ffa_ch4_ffacalc.kv 51 Get_Argument(1, Arg1); -- First arg
ffa_ch4_ffacalc.kv 52 Get_Argument(2, Arg2); -- Second arg
ffa_ch4_ffacalc.kv 53
ffa_ch8_randomism.kv 54 if Arg_Count = 4 then
ffa_ch8_randomism.kv 55 -- RNG was specified:
ffa_ch8_randomism.kv 56 declare
ffa_ch8_randomism.kv 57 Arg3 : CmdLineArg;
ffa_ch8_randomism.kv 58 begin
ffa_ch8_randomism.kv 59 Get_Argument(3, Arg3); -- Third arg (optional)
ffa_ch8_randomism.kv 60
ffa_ch8_randomism.kv 61 -- Ada.Sequential_IO chokes on paths with trailing whitespace!
ffa_ch8_randomism.kv 62 -- So we have to give it a trimmed path. But we can't use
ffa_ch8_randomism.kv 63 -- Ada.Strings.Fixed.Trim, because it suffers from
ffa_ch8_randomism.kv 64 -- SecondaryStackism-syphilis. Instead we are stuck doing this:
ffa_ch8_randomism.kv 65 Init_RNG(RNG, Arg3(Arg3'First .. Len_Arg(3)));
ffa_ch8_randomism.kv 66 end;
ffa_ch8_randomism.kv 67 else
ffa_ch8_randomism.kv 68 -- RNG was NOT specified:
ffa_ch8_randomism.kv 69 Init_RNG(RNG); -- Use the machine default then
ffa_ch8_randomism.kv 70 end if;
ffa_ch8_randomism.kv 71
ffa_ch4_ffacalc.kv 72 -- Parse into Positives:
ffa_ch4_ffacalc.kv 73 Width := Positive'Value(Arg1);
ffa_ch4_ffacalc.kv 74 Height := Positive'Value(Arg2);
ffa_ch4_ffacalc.kv 75 exception
ffa_ch4_ffacalc.kv 76 when others =>
ffa_ch4_ffacalc.kv 77 Eggog("Invalid arguments!");
ffa_ch4_ffacalc.kv 78 end;
ffa_ch4_ffacalc.kv 79
ffa_ch4_ffacalc.kv 80 -- Test if proposed Width is permissible:
ffa_ch11_tuning_a... 81 if not FFA_FZ_Valid_Bitness_P(Width) then
ffa_ch11_tuning_a... 82 Eggog("Invalid Width: " & FFA_Validity_Rule_Doc);
ffa_ch4_ffacalc.kv 83 end if;
ffa_ch4_ffacalc.kv 84
ffa_ch4_ffacalc.kv 85 -- The Calculator itself:
ffa_ch4_ffacalc.kv 86 declare
ffa_ch4_ffacalc.kv 87
ffa_ch4_ffacalc.kv 88 -- The number of Words required to make a FZ of the given Bitness.
ffa_ch4_ffacalc.kv 89 Wordness : Indices := Indices(Width / Bitness);
ffa_ch4_ffacalc.kv 90
ffa_ch4_ffacalc.kv 91 --------------------------------------------------------
ffa_ch4_ffacalc.kv 92 -- State --
ffa_ch4_ffacalc.kv 93 --------------------------------------------------------
ffa_ch4_ffacalc.kv 94 -- The Stack:
ffa_ch4_ffacalc.kv 95 subtype Stack_Positions is Natural range 0 .. Height;
ffa_ch4_ffacalc.kv 96 type Stacks is array(Stack_Positions range <>) of FZ(1 .. Wordness);
ffa_ch4_ffacalc.kv 97 Stack : Stacks(Stack_Positions'Range);
ffa_ch4_ffacalc.kv 98
ffa_ch4_ffacalc.kv 99 -- Stack Pointer:
ffa_ch4_ffacalc.kv 100 SP : Stack_Positions := Stack_Positions'First;
ffa_ch4_ffacalc.kv 101
ffa_ch4_ffacalc.kv 102 -- Carry/Borrow Flag:
ffa_ch4_ffacalc.kv 103 Flag : WBool := 0;
ffa_ch4_ffacalc.kv 104
ffa_ch4_ffacalc.kv 105 -- Odometer:
ffa_ch4_ffacalc.kv 106 Pos : Natural := 0;
ffa_ch4_ffacalc.kv 107
ffa_ch4_ffacalc.kv 108 -- The current levels of the three types of nestedness:
ffa_ch4_ffacalc.kv 109 QuoteLevel : Natural := 0;
ffa_ch4_ffacalc.kv 110 CommLevel : Natural := 0;
ffa_ch4_ffacalc.kv 111 CondLevel : Natural := 0;
ffa_ch13_measure_... 112
ffa_ch13_measure_... 113 -- Prefixed Operators
ffa_ch13_measure_... 114 PrevC : Character := ' ';
ffa_ch13_measure_... 115 HavePrefix : Boolean := False;
ffa_ch13_measure_... 116
ffa_ch4_ffacalc.kv 117 --------------------------------------------------------
ffa_ch4_ffacalc.kv 118
ffa_ch4_ffacalc.kv 119
ffa_ch4_ffacalc.kv 120 -- Clear the stack and set SP to bottom.
ffa_ch4_ffacalc.kv 121 procedure Zap is
ffa_ch4_ffacalc.kv 122 begin
ffa_ch4_ffacalc.kv 123 -- Clear the stack
ffa_ch4_ffacalc.kv 124 for i in Stack'Range loop
ffa_ch11_tuning_a... 125 FFA_FZ_Clear(Stack(i));
ffa_ch4_ffacalc.kv 126 end loop;
ffa_ch4_ffacalc.kv 127 -- Set SP to bottom
ffa_ch4_ffacalc.kv 128 SP := Stack_Positions'First;
ffa_ch4_ffacalc.kv 129 -- Clear Overflow flag
ffa_ch4_ffacalc.kv 130 Flag := 0;
ffa_ch13_measure_... 131 -- Clear prefix
ffa_ch13_measure_... 132 HavePrefix := False;
ffa_ch13_measure_... 133 PrevC := ' ';
ffa_ch4_ffacalc.kv 134 end Zap;
ffa_ch4_ffacalc.kv 135
ffa_ch4_ffacalc.kv 136
ffa_ch4_ffacalc.kv 137 -- Report a fatal error condition at the current symbol
ffa_ch4_ffacalc.kv 138 procedure E(S : in String) is
ffa_ch4_ffacalc.kv 139 begin
ffa_ch4_ffacalc.kv 140 Eggog("Pos:" & Natural'Image(Pos) & ": " & S);
ffa_ch4_ffacalc.kv 141 end E;
ffa_ch4_ffacalc.kv 142
ffa_ch4_ffacalc.kv 143
ffa_ch4_ffacalc.kv 144 -- Move SP up
ffa_ch4_ffacalc.kv 145 procedure Push is
ffa_ch4_ffacalc.kv 146 begin
ffa_ch4_ffacalc.kv 147 if SP = Stack_Positions'Last then
ffa_ch4_ffacalc.kv 148 E("Stack Overflow!");
ffa_ch4_ffacalc.kv 149 else
ffa_ch4_ffacalc.kv 150 SP := SP + 1;
ffa_ch4_ffacalc.kv 151 end if;
ffa_ch4_ffacalc.kv 152 end Push;
ffa_ch4_ffacalc.kv 153
ffa_ch4_ffacalc.kv 154
ffa_ch4_ffacalc.kv 155 -- Discard the top of the stack
ffa_ch4_ffacalc.kv 156 procedure Drop is
ffa_ch4_ffacalc.kv 157 begin
ffa_ch11_tuning_a... 158 FFA_FZ_Clear(Stack(SP));
ffa_ch4_ffacalc.kv 159 SP := SP - 1;
ffa_ch4_ffacalc.kv 160 end Drop;
ffa_ch4_ffacalc.kv 161
ffa_ch4_ffacalc.kv 162
ffa_ch4_ffacalc.kv 163 -- Check if stack has the necessary N items
ffa_ch4_ffacalc.kv 164 procedure Want(N : in Positive) is
ffa_ch4_ffacalc.kv 165 begin
ffa_ch4_ffacalc.kv 166 if SP < N then
ffa_ch4_ffacalc.kv 167 E("Stack Underflow!");
ffa_ch4_ffacalc.kv 168 end if;
ffa_ch4_ffacalc.kv 169 end Want;
ffa_ch4_ffacalc.kv 170
ffa_ch4_ffacalc.kv 171
ffa_ch5_egypt.kv 172 -- Ensure that a divisor is not zero
ffa_ch5_egypt.kv 173 procedure MustNotZero(D : in FZ) is
ffa_ch5_egypt.kv 174 begin
ffa_ch11_tuning_a... 175 if FFA_FZ_ZeroP(D) = 1 then
ffa_ch5_egypt.kv 176 E("Division by Zero!");
ffa_ch5_egypt.kv 177 end if;
ffa_ch5_egypt.kv 178 end MustNotZero;
ffa_ch5_egypt.kv 179
ffa_ch5_egypt.kv 180
ffa_ch4_ffacalc.kv 181 -- Slide a new hex digit into the FZ on top of stack
ffa_ch11_tuning_a... 182 procedure Ins_Hex_Digit(Digit : in Nibble) is
ffa_ch11_tuning_a... 183 Overflow : WBool := 0;
ffa_ch4_ffacalc.kv 184 begin
ffa_ch11_tuning_a... 185
ffa_ch11_tuning_a... 186 -- Insert the given nibble, and detect any overflow:
ffa_ch11_tuning_a... 187 FFA_FZ_Insert_Bottom_Nibble(N => Stack(SP),
ffa_ch11_tuning_a... 188 D => Digit,
ffa_ch11_tuning_a... 189 Overflow => Overflow);
ffa_ch4_ffacalc.kv 190
ffa_ch4_ffacalc.kv 191 -- Constants which exceed the Width are forbidden:
ffa_ch11_tuning_a... 192 if Overflow = 1 then
ffa_ch4_ffacalc.kv 193 E("Constant Exceeds Bitness!");
ffa_ch4_ffacalc.kv 194 end if;
ffa_ch4_ffacalc.kv 195
ffa_ch4_ffacalc.kv 196 end;
ffa_ch4_ffacalc.kv 197
ffa_ch4_ffacalc.kv 198
ffa_ch11_tuning_a... 199 -- Emit an ASCII representation of N to the terminal
ffa_ch11_tuning_a... 200 procedure Print_FZ(N : in FZ) is
ffa_ch11_tuning_a... 201 S : String(1 .. FFA_FZ_ASCII_Length(N)); -- Mandatorily, exact size
ffa_ch11_tuning_a... 202 begin
ffa_ch11_tuning_a... 203 FFA_FZ_To_Hex_String(N, S); -- Convert N to ASCII hex
ffa_ch11_tuning_a... 204 Write_String(S); -- Print the result to stdout
ffa_ch11_tuning_a... 205 Write_Newline; -- Print newline, for clarity.
ffa_ch11_tuning_a... 206 end Print_FZ;
ffa_ch11_tuning_a... 207
ffa_ch11_tuning_a... 208
ffa_ch13_measure_... 209 -- Denote that the given op is a prefix
ffa_ch13_measure_... 210 procedure IsPrefix is
ffa_ch13_measure_... 211 begin
ffa_ch13_measure_... 212 HavePrefix := True;
ffa_ch13_measure_... 213 end IsPrefix;
ffa_ch13_measure_... 214
ffa_ch13_measure_... 215
ffa_ch4_ffacalc.kv 216 -- Execute a Normal Op
ffa_ch4_ffacalc.kv 217 procedure Op_Normal(C : in Character) is
ffa_ch4_ffacalc.kv 218
ffa_ch4_ffacalc.kv 219 -- Over/underflow output from certain ops
ffa_ch4_ffacalc.kv 220 F : Word;
ffa_ch4_ffacalc.kv 221
ffa_ch4_ffacalc.kv 222 begin
ffa_ch4_ffacalc.kv 223
ffa_ch4_ffacalc.kv 224 case C is
ffa_ch4_ffacalc.kv 225
ffa_ch4_ffacalc.kv 226 --------------
ffa_ch4_ffacalc.kv 227 -- Stickies --
ffa_ch4_ffacalc.kv 228 --------------
ffa_ch4_ffacalc.kv 229 -- Enter Commented
ffa_ch4_ffacalc.kv 230 when '(' =>
ffa_ch4_ffacalc.kv 231 CommLevel := 1;
ffa_ch4_ffacalc.kv 232
ffa_ch4_ffacalc.kv 233 -- Exit Commented (but we aren't in it!)
ffa_ch4_ffacalc.kv 234 when ')' =>
ffa_ch4_ffacalc.kv 235 E("Mismatched close-comment parenthesis !");
ffa_ch4_ffacalc.kv 236
ffa_ch4_ffacalc.kv 237 -- Enter Quoted
ffa_ch4_ffacalc.kv 238 when '[' =>
ffa_ch4_ffacalc.kv 239 QuoteLevel := 1;
ffa_ch4_ffacalc.kv 240
ffa_ch4_ffacalc.kv 241 -- Exit Quoted (but we aren't in it!)
ffa_ch4_ffacalc.kv 242 when ']' =>
ffa_ch4_ffacalc.kv 243 E("Mismatched close-quote bracket !");
ffa_ch4_ffacalc.kv 244
ffa_ch4_ffacalc.kv 245 -- Enter a ~taken~ Conditional branch:
ffa_ch4_ffacalc.kv 246 when '{' =>
ffa_ch4_ffacalc.kv 247 Want(1);
ffa_ch11_tuning_a... 248 if FFA_FZ_ZeroP(Stack(SP)) = 1 then
ffa_ch4_ffacalc.kv 249 CondLevel := 1;
ffa_ch4_ffacalc.kv 250 end if;
ffa_ch4_ffacalc.kv 251 Drop;
ffa_ch4_ffacalc.kv 252
ffa_ch4_ffacalc.kv 253 -- Exit from a ~non-taken~ Conditional branch:
ffa_ch4_ffacalc.kv 254 -- ... we push a 0, to suppress the 'else' clause
ffa_ch4_ffacalc.kv 255 when '}' =>
ffa_ch4_ffacalc.kv 256 Push;
ffa_ch11_tuning_a... 257 FFA_WBool_To_FZ(0, Stack(SP));
ffa_ch4_ffacalc.kv 258
ffa_ch4_ffacalc.kv 259 ----------------
ffa_ch4_ffacalc.kv 260 -- Immediates --
ffa_ch4_ffacalc.kv 261 ----------------
ffa_ch4_ffacalc.kv 262
ffa_ch4_ffacalc.kv 263 -- These operate on the FZ ~currently~ at top of the stack;
ffa_ch4_ffacalc.kv 264 -- and this means that the stack may NOT be empty.
ffa_ch4_ffacalc.kv 265
ffa_ch4_ffacalc.kv 266 when '0' .. '9' =>
ffa_ch4_ffacalc.kv 267 Want(1);
ffa_ch11_tuning_a... 268 Ins_Hex_Digit(Character'Pos(C) - Character'Pos('0'));
ffa_ch4_ffacalc.kv 269
ffa_ch4_ffacalc.kv 270 when 'A' .. 'F' =>
ffa_ch4_ffacalc.kv 271 Want(1);
ffa_ch11_tuning_a... 272 Ins_Hex_Digit(10 + Character'Pos(C) - Character'Pos('A'));
ffa_ch4_ffacalc.kv 273
ffa_ch4_ffacalc.kv 274 when 'a' .. 'f' =>
ffa_ch4_ffacalc.kv 275 Want(1);
ffa_ch11_tuning_a... 276 Ins_Hex_Digit(10 + Character'Pos(C) - Character'Pos('a'));
ffa_ch4_ffacalc.kv 277
ffa_ch4_ffacalc.kv 278 ------------------
ffa_ch4_ffacalc.kv 279 -- Stack Motion --
ffa_ch4_ffacalc.kv 280 ------------------
ffa_ch4_ffacalc.kv 281
ffa_ch4_ffacalc.kv 282 -- Push a 0 onto the stack
ffa_ch4_ffacalc.kv 283 when '.' =>
ffa_ch4_ffacalc.kv 284 Push;
ffa_ch11_tuning_a... 285 FFA_FZ_Clear(Stack(SP));
ffa_ch4_ffacalc.kv 286
ffa_ch4_ffacalc.kv 287 -- Dup
ffa_ch4_ffacalc.kv 288 when '"' =>
ffa_ch4_ffacalc.kv 289 Want(1);
ffa_ch4_ffacalc.kv 290 Push;
ffa_ch4_ffacalc.kv 291 Stack(SP) := Stack(SP - 1);
ffa_ch4_ffacalc.kv 292
ffa_ch4_ffacalc.kv 293 -- Drop
ffa_ch4_ffacalc.kv 294 when '_' =>
ffa_ch4_ffacalc.kv 295 Want(1);
ffa_ch4_ffacalc.kv 296 Drop;
ffa_ch4_ffacalc.kv 297
ffa_ch4_ffacalc.kv 298 -- Swap
ffa_ch4_ffacalc.kv 299 when ''' =>
ffa_ch4_ffacalc.kv 300 Want(2);
ffa_ch11_tuning_a... 301 FFA_FZ_Swap(Stack(SP), Stack(SP - 1));
ffa_ch4_ffacalc.kv 302
ffa_ch4_ffacalc.kv 303 -- Over
ffa_ch4_ffacalc.kv 304 when '`' =>
ffa_ch4_ffacalc.kv 305 Want(2);
ffa_ch4_ffacalc.kv 306 Push;
ffa_ch4_ffacalc.kv 307 Stack(SP) := Stack(SP - 2);
ffa_ch4_ffacalc.kv 308
ffa_ch4_ffacalc.kv 309 ----------------
ffa_ch4_ffacalc.kv 310 -- Predicates --
ffa_ch4_ffacalc.kv 311 ----------------
ffa_ch4_ffacalc.kv 312
ffa_ch4_ffacalc.kv 313 -- Equality
ffa_ch4_ffacalc.kv 314 when '=' =>
ffa_ch4_ffacalc.kv 315 Want(2);
ffa_ch11_tuning_a... 316 FFA_WBool_To_FZ(FFA_FZ_EqP(X => Stack(SP),
ffa_ch11_tuning_a... 317 Y => Stack(SP - 1)),
ffa_ch11_tuning_a... 318 Stack(SP - 1));
ffa_ch4_ffacalc.kv 319 Drop;
ffa_ch4_ffacalc.kv 320
ffa_ch4_ffacalc.kv 321 -- Less-Than
ffa_ch4_ffacalc.kv 322 when '<' =>
ffa_ch4_ffacalc.kv 323 Want(2);
ffa_ch11_tuning_a... 324 FFA_WBool_To_FZ(FFA_FZ_LessThanP(X => Stack(SP - 1),
ffa_ch11_tuning_a... 325 Y => Stack(SP)),
ffa_ch11_tuning_a... 326 Stack(SP - 1));
ffa_ch4_ffacalc.kv 327 Drop;
ffa_ch4_ffacalc.kv 328
ffa_ch4_ffacalc.kv 329 -- Greater-Than
ffa_ch4_ffacalc.kv 330 when '>' =>
ffa_ch4_ffacalc.kv 331 Want(2);
ffa_ch11_tuning_a... 332 FFA_WBool_To_FZ(FFA_FZ_GreaterThanP(X => Stack(SP - 1),
ffa_ch11_tuning_a... 333 Y => Stack(SP)),
ffa_ch11_tuning_a... 334 Stack(SP - 1));
ffa_ch4_ffacalc.kv 335 Drop;
ffa_ch4_ffacalc.kv 336
ffa_ch4_ffacalc.kv 337 ----------------
ffa_ch4_ffacalc.kv 338 -- Arithmetic --
ffa_ch4_ffacalc.kv 339 ----------------
ffa_ch4_ffacalc.kv 340
ffa_ch4_ffacalc.kv 341 -- Subtract
ffa_ch4_ffacalc.kv 342 when '-' =>
ffa_ch4_ffacalc.kv 343 Want(2);
ffa_ch11_tuning_a... 344 FFA_FZ_Subtract(X => Stack(SP - 1),
ffa_ch11_tuning_a... 345 Y => Stack(SP),
ffa_ch11_tuning_a... 346 Difference => Stack(SP - 1),
ffa_ch11_tuning_a... 347 Underflow => F);
ffa_ch11_tuning_a... 348 Flag := FFA_Word_NZeroP(F);
ffa_ch4_ffacalc.kv 349 Drop;
ffa_ch4_ffacalc.kv 350
ffa_ch4_ffacalc.kv 351 -- Add
ffa_ch4_ffacalc.kv 352 when '+' =>
ffa_ch4_ffacalc.kv 353 Want(2);
ffa_ch11_tuning_a... 354 FFA_FZ_Add(X => Stack(SP - 1),
ffa_ch11_tuning_a... 355 Y => Stack(SP),
ffa_ch11_tuning_a... 356 Sum => Stack(SP - 1),
ffa_ch11_tuning_a... 357 Overflow => F);
ffa_ch11_tuning_a... 358 Flag := FFA_Word_NZeroP(F);
ffa_ch4_ffacalc.kv 359 Drop;
ffa_ch4_ffacalc.kv 360
ffa_ch5_egypt.kv 361 -- Divide and give Quotient and Remainder
ffa_ch5_egypt.kv 362 when '\' =>
ffa_ch5_egypt.kv 363 Want(2);
ffa_ch5_egypt.kv 364 MustNotZero(Stack(SP));
ffa_ch11_tuning_a... 365 FFA_FZ_IDiv(Dividend => Stack(SP - 1),
ffa_ch11_tuning_a... 366 Divisor => Stack(SP),
ffa_ch11_tuning_a... 367 Quotient => Stack(SP - 1),
ffa_ch11_tuning_a... 368 Remainder => Stack(SP));
ffa_ch5_egypt.kv 369
ffa_ch5_egypt.kv 370 -- Divide and give Quotient only
ffa_ch5_egypt.kv 371 when '/' =>
ffa_ch5_egypt.kv 372 Want(2);
ffa_ch5_egypt.kv 373 MustNotZero(Stack(SP));
ffa_ch11_tuning_a... 374 FFA_FZ_Div(Dividend => Stack(SP - 1),
ffa_ch11_tuning_a... 375 Divisor => Stack(SP),
ffa_ch11_tuning_a... 376 Quotient => Stack(SP - 1));
ffa_ch5_egypt.kv 377 Drop;
ffa_ch5_egypt.kv 378
ffa_ch5_egypt.kv 379 -- Divide and give Remainder only
ffa_ch5_egypt.kv 380 when '%' =>
ffa_ch5_egypt.kv 381 Want(2);
ffa_ch5_egypt.kv 382 MustNotZero(Stack(SP));
ffa_ch11_tuning_a... 383 FFA_FZ_Mod(Dividend => Stack(SP - 1),
ffa_ch11_tuning_a... 384 Divisor => Stack(SP),
ffa_ch11_tuning_a... 385 Remainder => Stack(SP - 1));
ffa_ch5_egypt.kv 386 Drop;
ffa_ch5_egypt.kv 387
ffa_ch5_egypt.kv 388 -- Multiply, give bottom and top halves
ffa_ch5_egypt.kv 389 when '*' =>
ffa_ch5_egypt.kv 390 Want(2);
ffa_ch11_tuning_a... 391 FFA_FZ_Multiply(X => Stack(SP - 1),
ffa_ch11_tuning_a... 392 Y => Stack(SP),
ffa_ch11_tuning_a... 393 XY_Lo => Stack(SP - 1),
ffa_ch11_tuning_a... 394 XY_Hi => Stack(SP));
ffa_ch5_egypt.kv 395
ffa_ch15_gcd.kv 396 -- Square, give bottom and top halves
ffa_ch15_gcd.kv 397 when 'S' =>
ffa_ch15_gcd.kv 398 Want(1);
ffa_ch15_gcd.kv 399 Push;
ffa_ch15_gcd.kv 400 FFA_FZ_Square(X => Stack(SP - 1),
ffa_ch15_gcd.kv 401 XX_Lo => Stack(SP - 1),
ffa_ch15_gcd.kv 402 XX_Hi => Stack(SP));
ffa_ch15_gcd.kv 403
ffa_ch15_gcd.kv 404 -- Greatest Common Divisor (GCD)
ffa_ch15_gcd.kv 405 when 'G' =>
ffa_ch15_gcd.kv 406 Want(2);
ffa_ch15_gcd.kv 407
ffa_ch15_gcd.kv 408 -- Note that GCD(0,0) is not factually zero, or unique.
ffa_ch15_gcd.kv 409 -- But it is permissible to define it as zero.
ffa_ch15_gcd.kv 410 -- (See Ch. 15 discussion.)
ffa_ch15_gcd.kv 411
ffa_ch15_gcd.kv 412 FFA_FZ_Greatest_Common_Divisor(X => Stack(SP - 1),
ffa_ch15_gcd.kv 413 Y => Stack(SP),
ffa_ch15_gcd.kv 414 Result => Stack(SP - 1));
ffa_ch15_gcd.kv 415 Drop;
ffa_ch15_gcd.kv 416
ffa_ch4_ffacalc.kv 417 -----------------
ffa_ch4_ffacalc.kv 418 -- Bitwise Ops --
ffa_ch4_ffacalc.kv 419 -----------------
ffa_ch4_ffacalc.kv 420
ffa_ch4_ffacalc.kv 421 -- Bitwise-And
ffa_ch4_ffacalc.kv 422 when '&' =>
ffa_ch4_ffacalc.kv 423 Want(2);
ffa_ch11_tuning_a... 424 FFA_FZ_And(X => Stack(SP - 1),
ffa_ch11_tuning_a... 425 Y => Stack(SP),
ffa_ch11_tuning_a... 426 Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv 427 Drop;
ffa_ch4_ffacalc.kv 428
ffa_ch4_ffacalc.kv 429 -- Bitwise-Or
ffa_ch4_ffacalc.kv 430 when '|' =>
ffa_ch4_ffacalc.kv 431 Want(2);
ffa_ch11_tuning_a... 432 FFA_FZ_Or(X => Stack(SP - 1),
ffa_ch11_tuning_a... 433 Y => Stack(SP),
ffa_ch11_tuning_a... 434 Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv 435 Drop;
ffa_ch4_ffacalc.kv 436
ffa_ch4_ffacalc.kv 437 -- Bitwise-Xor
ffa_ch4_ffacalc.kv 438 when '^' =>
ffa_ch4_ffacalc.kv 439 Want(2);
ffa_ch11_tuning_a... 440 FFA_FZ_Xor(X => Stack(SP - 1),
ffa_ch11_tuning_a... 441 Y => Stack(SP),
ffa_ch11_tuning_a... 442 Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv 443 Drop;
ffa_ch4_ffacalc.kv 444
ffa_ch4_ffacalc.kv 445 -- Bitwise-Not (1s-Complement)
ffa_ch4_ffacalc.kv 446 when '~' =>
ffa_ch4_ffacalc.kv 447 Want(1);
ffa_ch11_tuning_a... 448 FFA_FZ_Not(Stack(SP), Stack(SP));
ffa_ch4_ffacalc.kv 449
ffa_ch4_ffacalc.kv 450 -----------
ffa_ch4_ffacalc.kv 451 -- Other --
ffa_ch4_ffacalc.kv 452 -----------
ffa_ch4_ffacalc.kv 453
ffa_ch8_randomism.kv 454 -- Push a FZ of RNGolade onto the stack
ffa_ch8_randomism.kv 455 when '?' =>
ffa_ch8_randomism.kv 456 Push;
ffa_ch11_tuning_a... 457 FFA_FZ_Clear(Stack(SP));
ffa_ch8_randomism.kv 458 FZ_Random(RNG, Stack(SP));
ffa_ch8_randomism.kv 459
ffa_ch4_ffacalc.kv 460 -- mUx
ffa_ch4_ffacalc.kv 461 when 'U' =>
ffa_ch4_ffacalc.kv 462 Want(3);
ffa_ch11_tuning_a... 463 FFA_FZ_Mux(X => Stack(SP - 2),
ffa_ch11_tuning_a... 464 Y => Stack(SP - 1),
ffa_ch11_tuning_a... 465 Result => Stack(SP - 2),
ffa_ch11_tuning_a... 466 Sel => FFA_FZ_NZeroP(Stack(SP)));
ffa_ch4_ffacalc.kv 467 Drop;
ffa_ch4_ffacalc.kv 468 Drop;
ffa_ch4_ffacalc.kv 469
ffa_ch13_measure_... 470 -- Find the position of eldest nonzero bit, if any exist
ffa_ch13_measure_... 471 when 'W' =>
ffa_ch13_measure_... 472 Want(1);
ffa_ch13_measure_... 473 declare
ffa_ch13_measure_... 474 -- Find the measure ( 0 if no 1s, or 1 .. FZBitness )
ffa_ch14_barrett.kv 475 Measure : FZBit_Index := FFA_FZ_Measure(Stack(SP));
ffa_ch14_barrett.kv 476 begin
ffa_ch13_measure_... 477 -- Put on top of stack
ffa_ch13_measure_... 478 FFA_FZ_Clear(Stack(SP));
ffa_ch14_barrett.kv 479 FFA_FZ_Set_Head(Stack(SP), Word(Measure));
ffa_ch13_measure_... 480 end;
ffa_ch13_measure_... 481
ffa_ch4_ffacalc.kv 482 -- Put the Overflow flag on the stack
ffa_ch4_ffacalc.kv 483 when 'O' =>
ffa_ch4_ffacalc.kv 484 Push;
ffa_ch11_tuning_a... 485 FFA_WBool_To_FZ(Flag, Stack(SP));
ffa_ch4_ffacalc.kv 486
ffa_ch4_ffacalc.kv 487 -- Print the FZ on the top of the stack
ffa_ch4_ffacalc.kv 488 when '#' =>
ffa_ch4_ffacalc.kv 489 Want(1);
ffa_ch11_tuning_a... 490 Print_FZ(Stack(SP));
ffa_ch4_ffacalc.kv 491 Drop;
ffa_ch4_ffacalc.kv 492
ffa_ch4_ffacalc.kv 493 -- Zap (reset)
ffa_ch4_ffacalc.kv 494 when 'Z' =>
ffa_ch4_ffacalc.kv 495 Zap;
ffa_ch4_ffacalc.kv 496
ffa_ch4_ffacalc.kv 497 -- Quit with Stack Trace
ffa_ch4_ffacalc.kv 498 when 'Q' =>
ffa_ch4_ffacalc.kv 499 for I in reverse Stack'First + 1 .. SP loop
ffa_ch11_tuning_a... 500 Print_FZ(Stack(I));
ffa_ch4_ffacalc.kv 501 end loop;
ffa_ch4_ffacalc.kv 502 Quit(0);
ffa_ch4_ffacalc.kv 503
ffa_ch14_barrett.kv 504 -- Put the FFACalc Program Version on the stack,
ffa_ch14_barrett.kv 505 -- followed by FFA Program Version.
ffa_ch14_barrett.kv 506 when 'V' =>
ffa_ch14_barrett.kv 507 Push;
ffa_ch14_barrett.kv 508 Push;
ffa_ch14_barrett.kv 509 -- FFACalc Version:
ffa_ch14_barrett.kv 510 FFA_FZ_Clear(Stack(SP - 1));
ffa_ch14_barrett.kv 511 FFA_FZ_Set_Head(Stack(SP - 1), Word(FFACalc_K_Version));
ffa_ch14_barrett.kv 512 -- FFA Version:
ffa_ch14_barrett.kv 513 FFA_FZ_Clear(Stack(SP));
ffa_ch14_barrett.kv 514 FFA_FZ_Set_Head(Stack(SP), Word(FFA_K_Version));
ffa_ch14_barrett.kv 515
ffa_ch13_measure_... 516 --------------
ffa_ch13_measure_... 517 -- Prefixes --
ffa_ch13_measure_... 518 --------------
ffa_ch13_measure_... 519
ffa_ch13_measure_... 520 -- 'Left...' :
ffa_ch13_measure_... 521 when 'L' =>
ffa_ch13_measure_... 522 IsPrefix;
ffa_ch13_measure_... 523
ffa_ch13_measure_... 524 -- 'Right...' :
ffa_ch13_measure_... 525 when 'R' =>
ffa_ch13_measure_... 526 IsPrefix;
ffa_ch13_measure_... 527
ffa_ch13_measure_... 528 -- 'Modular...' :
ffa_ch13_measure_... 529 when 'M' =>
ffa_ch13_measure_... 530 IsPrefix;
ffa_ch13_measure_... 531
ffa_ch13_measure_... 532 ---------------------------------------------------------
ffa_ch13_measure_... 533 -- Reserved Ops, i.e. ones we have not defined yet: --
ffa_ch13_measure_... 534 ---------------------------------------------------------
ffa_ch13_measure_... 535 when '!' | '@' | '$' | ':' | ';' | ',' |
ffa_ch15_gcd.kv 536 'H' | 'I' | 'J' | 'K' | 'N' |
ffa_ch14_barrett.kv 537 'P' | 'T' | 'X' | 'Y' =>
ffa_ch13_measure_... 538
ffa_ch13_measure_... 539 E("This Operator is not defined yet: " & C);
ffa_ch12_karatsub... 540 ---------------------------------------------------------
ffa_ch12_karatsub... 541
ffa_ch4_ffacalc.kv 542 ----------
ffa_ch4_ffacalc.kv 543 -- NOPs --
ffa_ch4_ffacalc.kv 544 ----------
ffa_ch4_ffacalc.kv 545
ffa_ch13_measure_... 546 -- Unprintables and spaces DO NOTHING:
ffa_ch4_ffacalc.kv 547 when others =>
ffa_ch4_ffacalc.kv 548 null;
ffa_ch4_ffacalc.kv 549
ffa_ch4_ffacalc.kv 550 end case;
ffa_ch4_ffacalc.kv 551
ffa_ch4_ffacalc.kv 552 end Op_Normal;
ffa_ch4_ffacalc.kv 553
ffa_ch4_ffacalc.kv 554
ffa_ch13_measure_... 555 -- Execute a Prefixed Op
ffa_ch13_measure_... 556 procedure Op_Prefixed(Prefix : in Character;
ffa_ch13_measure_... 557 O : in Character) is
ffa_ch13_measure_... 558 begin
ffa_ch13_measure_... 559
ffa_ch13_measure_... 560 -- The Prefixed Op:
ffa_ch13_measure_... 561 case Prefix is
ffa_ch13_measure_... 562
ffa_ch13_measure_... 563 ---------------------------------------------------------
ffa_ch13_measure_... 564 -- Left...
ffa_ch13_measure_... 565 when 'L' =>
ffa_ch13_measure_... 566
ffa_ch13_measure_... 567 -- Which L-op?
ffa_ch13_measure_... 568 case O is
ffa_ch13_measure_... 569
ffa_ch13_measure_... 570 -- ... Shift :
ffa_ch13_measure_... 571 when 'S' =>
ffa_ch13_measure_... 572 Want(2);
ffa_ch13_measure_... 573 declare
ffa_ch13_measure_... 574 -- Number of bit positions to shift by:
ffa_ch13_measure_... 575 ShiftCount : FZBit_Index
ffa_ch13_measure_... 576 := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_... 577 begin
ffa_ch13_measure_... 578 FFA_FZ_Quiet_ShiftLeft(N => Stack(SP - 1),
ffa_ch13_measure_... 579 ShiftedN => Stack(SP - 1),
ffa_ch13_measure_... 580 Count => ShiftCount);
ffa_ch13_measure_... 581 end;
ffa_ch13_measure_... 582 Drop;
ffa_ch13_measure_... 583
ffa_ch13_measure_... 584 -- ... Rotate :
ffa_ch13_measure_... 585 when 'R' =>
ffa_ch13_measure_... 586 E("Left-Rotate not yet defined!");
ffa_ch13_measure_... 587
ffa_ch13_measure_... 588 -- ... Unknown:
ffa_ch13_measure_... 589 when others =>
ffa_ch13_measure_... 590 E("Undefined Op: L" & O);
ffa_ch13_measure_... 591
ffa_ch13_measure_... 592 end case;
ffa_ch13_measure_... 593 ---------------------------------------------------------
ffa_ch13_measure_... 594 -- Right...
ffa_ch13_measure_... 595 when 'R' =>
ffa_ch13_measure_... 596
ffa_ch13_measure_... 597 -- Which R-op?
ffa_ch13_measure_... 598 case O is
ffa_ch13_measure_... 599
ffa_ch13_measure_... 600 -- ... Shift:
ffa_ch13_measure_... 601 when 'S' =>
ffa_ch13_measure_... 602 Want(2);
ffa_ch13_measure_... 603 declare
ffa_ch13_measure_... 604 -- Number of bit positions to shift by:
ffa_ch13_measure_... 605 ShiftCount : FZBit_Index
ffa_ch13_measure_... 606 := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_... 607 begin
ffa_ch13_measure_... 608 FFA_FZ_Quiet_ShiftRight(N => Stack(SP - 1),
ffa_ch13_measure_... 609 ShiftedN => Stack(SP - 1),
ffa_ch13_measure_... 610 Count => ShiftCount);
ffa_ch13_measure_... 611 end;
ffa_ch13_measure_... 612 Drop;
ffa_ch13_measure_... 613
ffa_ch13_measure_... 614 -- ... Rotate:
ffa_ch13_measure_... 615 when 'R' =>
ffa_ch13_measure_... 616 E("Right-Rotate not yet defined!");
ffa_ch13_measure_... 617
ffa_ch15_gcd.kv 618 -- 'Right-Multiply', give only lower half of the product XY
ffa_ch15_gcd.kv 619 when '*' =>
ffa_ch15_gcd.kv 620 Want(2);
ffa_ch15_gcd.kv 621 FFA_FZ_Low_Multiply(X => Stack(SP - 1),
ffa_ch15_gcd.kv 622 Y => Stack(SP),
ffa_ch15_gcd.kv 623 XY => Stack(SP - 1));
ffa_ch15_gcd.kv 624 Drop;
ffa_ch15_gcd.kv 625
ffa_ch13_measure_... 626 -- ... Unknown:
ffa_ch13_measure_... 627 when others =>
ffa_ch13_measure_... 628 E("Undefined Op: R" & O);
ffa_ch13_measure_... 629
ffa_ch13_measure_... 630 end case;
ffa_ch13_measure_... 631 ---------------------------------------------------------
ffa_ch15_gcd.kv 632 -- Modular...
ffa_ch13_measure_... 633 when 'M' =>
ffa_ch13_measure_... 634
ffa_ch13_measure_... 635 -- Which M-op?
ffa_ch13_measure_... 636 case O is
ffa_ch13_measure_... 637
ffa_ch15_gcd.kv 638 -- ... Multiplication (Conventional) :
ffa_ch13_measure_... 639 when '*' =>
ffa_ch13_measure_... 640 Want(3);
ffa_ch13_measure_... 641 MustNotZero(Stack(SP));
ffa_ch13_measure_... 642 FFA_FZ_Modular_Multiply(X => Stack(SP - 2),
ffa_ch13_measure_... 643 Y => Stack(SP - 1),
ffa_ch13_measure_... 644 Modulus => Stack(SP),
ffa_ch13_measure_... 645 Product => Stack(SP - 2));
ffa_ch13_measure_... 646 Drop;
ffa_ch13_measure_... 647 Drop;
ffa_ch13_measure_... 648
ffa_ch15_gcd.kv 649 -- ... Squaring (Conventional) :
ffa_ch15_gcd.kv 650 when 'S' =>
ffa_ch15_gcd.kv 651 Want(2);
ffa_ch15_gcd.kv 652 MustNotZero(Stack(SP));
ffa_ch15_gcd.kv 653 FFA_FZ_Modular_Square(X => Stack(SP - 1),
ffa_ch15_gcd.kv 654 Modulus => Stack(SP),
ffa_ch15_gcd.kv 655 Product => Stack(SP - 1));
ffa_ch15_gcd.kv 656 Drop;
ffa_ch15_gcd.kv 657
ffa_ch15_gcd.kv 658 -- ... Exponentiation (Barrettronic) :
ffa_ch13_measure_... 659 when 'X' =>
ffa_ch13_measure_... 660 Want(3);
ffa_ch13_measure_... 661 MustNotZero(Stack(SP));
ffa_ch13_measure_... 662 FFA_FZ_Modular_Exponentiate(Base => Stack(SP - 2),
ffa_ch13_measure_... 663 Exponent => Stack(SP - 1),
ffa_ch13_measure_... 664 Modulus => Stack(SP),
ffa_ch13_measure_... 665 Result => Stack(SP - 2));
ffa_ch13_measure_... 666 Drop;
ffa_ch13_measure_... 667 Drop;
ffa_ch13_measure_... 668
ffa_ch13_measure_... 669 -- ... Unknown:
ffa_ch13_measure_... 670 when others =>
ffa_ch13_measure_... 671 E("Undefined Op: M" & O);
ffa_ch13_measure_... 672
ffa_ch13_measure_... 673 end case;
ffa_ch13_measure_... 674 ---------------------------------------------------------
ffa_ch13_measure_... 675 -- ... Unknown: (impossible per mechanics, but must handle case)
ffa_ch13_measure_... 676 when others =>
ffa_ch13_measure_... 677 E("Undefined Prefix: " & Prefix);
ffa_ch13_measure_... 678
ffa_ch13_measure_... 679 end case;
ffa_ch13_measure_... 680
ffa_ch13_measure_... 681 end Op_Prefixed;
ffa_ch13_measure_... 682
ffa_ch13_measure_... 683
ffa_ch4_ffacalc.kv 684 -- Process a Symbol
ffa_ch4_ffacalc.kv 685 procedure Op(C : in Character) is
ffa_ch4_ffacalc.kv 686 begin
ffa_ch4_ffacalc.kv 687 -- First, see whether we are in a state of nestedness:
ffa_ch4_ffacalc.kv 688
ffa_ch4_ffacalc.kv 689 -- ... in a Comment block:
ffa_ch4_ffacalc.kv 690 if CommLevel > 0 then
ffa_ch4_ffacalc.kv 691 case C is
ffa_ch4_ffacalc.kv 692 when ')' => -- Drop a nesting level:
ffa_ch4_ffacalc.kv 693 CommLevel := CommLevel - 1;
ffa_ch4_ffacalc.kv 694 when '(' => -- Add a nesting level:
ffa_ch4_ffacalc.kv 695 CommLevel := CommLevel + 1;
ffa_ch4_ffacalc.kv 696 when others =>
ffa_ch4_ffacalc.kv 697 null; -- Other symbols have no effect at all
ffa_ch4_ffacalc.kv 698 end case;
ffa_ch4_ffacalc.kv 699
ffa_ch4_ffacalc.kv 700 -- ... in a Quote block:
ffa_ch4_ffacalc.kv 701 elsif QuoteLevel > 0 then
ffa_ch4_ffacalc.kv 702 case C is
ffa_ch4_ffacalc.kv 703 when ']' => -- Drop a nesting level:
ffa_ch4_ffacalc.kv 704 QuoteLevel := QuoteLevel - 1;
ffa_ch4_ffacalc.kv 705 when '[' => -- Add a nesting level:
ffa_ch4_ffacalc.kv 706 QuoteLevel := QuoteLevel + 1;
ffa_ch4_ffacalc.kv 707 when others =>
ffa_ch4_ffacalc.kv 708 null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv 709 end case;
ffa_ch4_ffacalc.kv 710
ffa_ch4_ffacalc.kv 711 -- If we aren't the mode-exiting ']', print current symbol:
ffa_ch4_ffacalc.kv 712 if QuoteLevel > 0 then
ffa_ch4_ffacalc.kv 713 Write_Char(C);
ffa_ch4_ffacalc.kv 714 end if;
ffa_ch4_ffacalc.kv 715
ffa_ch4_ffacalc.kv 716 --- ... in a ~taken~ Conditional branch:
ffa_ch4_ffacalc.kv 717 elsif CondLevel > 0 then
ffa_ch4_ffacalc.kv 718 case C is
ffa_ch4_ffacalc.kv 719 when '}' => -- Drop a nesting level:
ffa_ch4_ffacalc.kv 720 CondLevel := CondLevel - 1;
ffa_ch4_ffacalc.kv 721
ffa_ch4_ffacalc.kv 722 -- If we exited the Conditional as a result,
ffa_ch4_ffacalc.kv 723 -- we push a 1 to trigger the possible 'else' clause:
ffa_ch4_ffacalc.kv 724 if CondLevel = 0 then
ffa_ch4_ffacalc.kv 725 Push;
ffa_ch11_tuning_a... 726 FFA_WBool_To_FZ(1, Stack(SP));
ffa_ch4_ffacalc.kv 727 end if;
ffa_ch4_ffacalc.kv 728
ffa_ch4_ffacalc.kv 729 when '{' => -- Add a nesting level:
ffa_ch4_ffacalc.kv 730 CondLevel := CondLevel + 1;
ffa_ch4_ffacalc.kv 731 when others =>
ffa_ch4_ffacalc.kv 732 null; -- Other symbols have no effect on the level
ffa_ch4_ffacalc.kv 733 end case;
ffa_ch13_measure_... 734
ffa_ch13_measure_... 735 --- ... if in a prefixed op:
ffa_ch13_measure_... 736 elsif HavePrefix then
ffa_ch13_measure_... 737
ffa_ch13_measure_... 738 -- Drop the prefix-op hammer, until another prefix-op cocks it
ffa_ch13_measure_... 739 HavePrefix := False;
ffa_ch13_measure_... 740
ffa_ch13_measure_... 741 -- Dispatch this op, where prefix is the preceding character
ffa_ch13_measure_... 742 Op_Prefixed(Prefix => PrevC, O => C);
ffa_ch13_measure_... 743
ffa_ch4_ffacalc.kv 744 else
ffa_ch4_ffacalc.kv 745 -- This is a Normal Op, so proceed with the normal rules.
ffa_ch4_ffacalc.kv 746 Op_Normal(C);
ffa_ch4_ffacalc.kv 747 end if;
ffa_ch4_ffacalc.kv 748
ffa_ch4_ffacalc.kv 749 end Op;
ffa_ch4_ffacalc.kv 750
ffa_ch4_ffacalc.kv 751
ffa_ch4_ffacalc.kv 752 -- Current Character
ffa_ch4_ffacalc.kv 753 C : Character;
ffa_ch4_ffacalc.kv 754
ffa_ch4_ffacalc.kv 755 begin
ffa_ch4_ffacalc.kv 756 -- Reset the Calculator
ffa_ch4_ffacalc.kv 757 Zap;
ffa_ch4_ffacalc.kv 758 -- Process characters until EOF:
ffa_ch4_ffacalc.kv 759 loop
ffa_ch4_ffacalc.kv 760 if Read_Char(C) then
ffa_ch4_ffacalc.kv 761 -- Execute Op:
ffa_ch4_ffacalc.kv 762 Op(C);
ffa_ch4_ffacalc.kv 763 -- Advance Odometer
ffa_ch4_ffacalc.kv 764 Pos := Pos + 1;
ffa_ch13_measure_... 765 -- Save the op for use in prefixed ops
ffa_ch13_measure_... 766 PrevC := C;
ffa_ch4_ffacalc.kv 767 else
ffa_ch4_ffacalc.kv 768 Zap;
ffa_ch4_ffacalc.kv 769 Quit(0); -- if EOF, we're done
ffa_ch4_ffacalc.kv 770 end if;
ffa_ch4_ffacalc.kv 771 end loop;
ffa_ch4_ffacalc.kv 772 end;
ffa_ch4_ffacalc.kv 773
ffa_ch4_ffacalc.kv 774 end FFA_Calc;