ffa_ch4_ffacalc.kv 1
ffa_ch4_ffacalc.kv 2
ffa_ch4_ffacalc.kv 3
ffa_ch4_ffacalc.kv 4
ffa_ch15_gcd.kv 5
ffa_ch4_ffacalc.kv 6
ffa_ch4_ffacalc.kv 7
ffa_ch4_ffacalc.kv 8
ffa_ch4_ffacalc.kv 9
ffa_ch4_ffacalc.kv 10
ffa_ch4_ffacalc.kv 11
ffa_ch4_ffacalc.kv 12
ffa_ch4_ffacalc.kv 13
ffa_ch4_ffacalc.kv 14
ffa_ch4_ffacalc.kv 15
ffa_ch4_ffacalc.kv 16
ffa_ch4_ffacalc.kv 17
ffa_ch4_ffacalc.kv 18
ffa_ch4_ffacalc.kv 19
ffa_ch4_ffacalc.kv 20
ffa_ch14_barrett.kv 21 with Version; use Version;
ffa_ch8_randomism.kv 22 with OS; use OS;
ffa_ch4_ffacalc.kv 23
ffa_ch4_ffacalc.kv 24
ffa_ch11_tuning_a... 25 with FFA; use FFA;
ffa_ch4_ffacalc.kv 26
ffa_ch11_tuning_a... 27
ffa_ch11_tuning_a... 28 use type FFA.Word;
ffa_ch4_ffacalc.kv 29
ffa_ch8_randomism.kv 30
ffa_ch8_randomism.kv 31 with FFA_RNG; use FFA_RNG;
ffa_ch8_randomism.kv 32
ffa_ch8_randomism.kv 33
ffa_ch17_peh.kv 34 package body FFA_Calc is
ffa_ch4_ffacalc.kv 35
ffa_ch17_peh.kv 36
ffa_ch17_peh.kv 37 procedure Validate_Peh_Dimensions(Dimensions : in Peh_Dimensions) is
ffa_ch4_ffacalc.kv 38 begin
ffa_ch17_peh.kv 39
ffa_ch17_peh.kv 40
ffa_ch17_peh.kv 41 if not FFA_FZ_Valid_Bitness_P(Dimensions.Width) then
ffa_ch17_peh.kv 42 Eggog("Requested Invalid FZ Width, " & FFA_Validity_Rule_Doc);
ffa_ch17_peh.kv 43 end if;
ffa_ch17_peh.kv 44
ffa_ch17_peh.kv 45
ffa_ch17_peh.kv 46 if Dimensions.Life = 0 then
ffa_ch17_peh.kv 47 Achtung("WARNING: Life=0 enables UNBOUNDED run time;" &
ffa_ch17_peh.kv 48 " halting cannot be guaranteed!");
ffa_ch8_randomism.kv 49 end if;
ffa_ch8_randomism.kv 50
ffa_ch17_peh.kv 51 end Validate_Peh_Dimensions;
ffa_ch4_ffacalc.kv 52
ffa_ch4_ffacalc.kv 53
ffa_ch17_peh.kv 54
ffa_ch17_peh.kv 55 function Peh_Machine(Dimensions : in Peh_Dimensions;
ffa_ch17_peh.kv 56 Tape : in Peh_Tapes;
ffa_ch17_peh.kv 57 RNG : in RNG_Device) return Peh_Verdicts is
ffa_ch4_ffacalc.kv 58
ffa_ch4_ffacalc.kv 59
ffa_ch17_peh.kv 60 Wordness : Indices := Indices(Dimensions.Width / Bitness);
ffa_ch4_ffacalc.kv 61
ffa_ch4_ffacalc.kv 62
ffa_ch4_ffacalc.kv 63
ffa_ch4_ffacalc.kv 64
ffa_ch17_peh.kv 65
ffa_ch17_peh.kv 66 subtype Stack_Positions is Natural range 0 .. Dimensions.Height;
ffa_ch4_ffacalc.kv 67 type Stacks is array(Stack_Positions range <>) of FZ(1 .. Wordness);
ffa_ch17_peh.kv 68 Stack : Stacks(Stack_Positions'Range);
ffa_ch17_peh.kv 69
ffa_ch17_peh.kv 70
ffa_ch17_peh.kv 71 SP : Stack_Positions := Stack_Positions'First;
ffa_ch17_peh.kv 72
ffa_ch17_peh.kv 73
ffa_ch17_peh.kv 74 subtype Tape_Positions is Peh_Tape_Range range Tape'First .. Tape'Last;
ffa_ch17_peh.kv 75
ffa_ch17_peh.kv 76
ffa_ch17_peh.kv 77 IP : Tape_Positions;
ffa_ch17_peh.kv 78
ffa_ch17_peh.kv 79
ffa_ch17_peh.kv 80 IP_Next : Tape_Positions;
ffa_ch17_peh.kv 81
ffa_ch17_peh.kv 82
ffa_ch17_peh.kv 83 Control_Stack : array(ControlStack_Range) of Tape_Positions
ffa_ch17_peh.kv 84 := (others => Tape_Positions'First);
ffa_ch4_ffacalc.kv 85
ffa_ch17_peh.kv 86
ffa_ch17_peh.kv 87 CSP : ControlStack_Range := ControlStack_Range'First;
ffa_ch17_peh.kv 88
ffa_ch17_peh.kv 89
ffa_ch17_peh.kv 90 subtype RegNames is Character range 'g' .. 'z';
ffa_ch17_peh.kv 91 type RegTables is array(RegNames range <>) of FZ(1 .. Wordness);
ffa_ch17_peh.kv 92 Registers : RegTables(RegNames'Range);
ffa_ch4_ffacalc.kv 93
ffa_ch4_ffacalc.kv 94
ffa_ch17_peh.kv 95 Flag : WBool := 0;
ffa_ch4_ffacalc.kv 96
ffa_ch4_ffacalc.kv 97
ffa_ch17_peh.kv 98 Ticks : Natural := 0;
ffa_ch4_ffacalc.kv 99
ffa_ch4_ffacalc.kv 100
ffa_ch17_peh.kv 101 QuoteLevel : Natural := 0;
ffa_ch17_peh.kv 102 CommLevel : Natural := 0;
ffa_ch17_peh.kv 103 CondLevel : Natural := 0;
ffa_ch13_measure_... 104
ffa_ch13_measure_... 105
ffa_ch17_peh.kv 106 PrevC : Character := ' ';
ffa_ch17_peh.kv 107 HavePrefix : Boolean := False;
ffa_ch13_measure_... 108
ffa_ch17_peh.kv 109
ffa_ch17_peh.kv 110 Verdict : Peh_Verdicts := Mu;
ffa_ch4_ffacalc.kv 111
ffa_ch4_ffacalc.kv 112
ffa_ch4_ffacalc.kv 113
ffa_ch17_peh.kv 114
ffa_ch17_peh.kv 115 function Exhausted_Life return Boolean is
ffa_ch17_peh.kv 116
ffa_ch17_peh.kv 117 MustDie : Boolean :=
ffa_ch17_peh.kv 118 (Dimensions.Life /= 0) and (Ticks = Dimensions.Life);
ffa_ch17_peh.kv 119 begin
ffa_ch17_peh.kv 120 if MustDie then
ffa_ch17_peh.kv 121 Achtung("WARNING: Exhausted Life ("
ffa_ch17_peh.kv 122 & Natural'Image(Ticks) & " ticks )");
ffa_ch17_peh.kv 123 end if;
ffa_ch17_peh.kv 124 return MustDie;
ffa_ch17_peh.kv 125 end Exhausted_Life;
ffa_ch17_peh.kv 126
ffa_ch17_peh.kv 127
ffa_ch17_peh.kv 128
ffa_ch4_ffacalc.kv 129 procedure Zap is
ffa_ch4_ffacalc.kv 130 begin
ffa_ch17_peh.kv 131
ffa_ch4_ffacalc.kv 132 for i in Stack'Range loop
ffa_ch11_tuning_a... 133 FFA_FZ_Clear(Stack(i));
ffa_ch4_ffacalc.kv 134 end loop;
ffa_ch17_peh.kv 135
ffa_ch17_peh.kv 136 SP := Stack_Positions'First;
ffa_ch17_peh.kv 137
ffa_ch17_peh.kv 138 for r in RegNames'Range loop
ffa_ch17_peh.kv 139 FFA_FZ_Clear(Registers(r));
ffa_ch17_peh.kv 140 end loop;
ffa_ch17_peh.kv 141
ffa_ch17_peh.kv 142 Flag := 0;
ffa_ch17_peh.kv 143
ffa_ch17_peh.kv 144 HavePrefix := False;
ffa_ch17_peh.kv 145 PrevC := ' ';
ffa_ch4_ffacalc.kv 146 end Zap;
ffa_ch4_ffacalc.kv 147
ffa_ch4_ffacalc.kv 148
ffa_ch17_peh.kv 149
ffa_ch17_peh.kv 150
ffa_ch4_ffacalc.kv 151 procedure E(S : in String) is
ffa_ch4_ffacalc.kv 152 begin
ffa_ch17_peh.kv 153 Zap;
ffa_ch17_peh.kv 154 Eggog("FATAL: Tick:" & Natural'Image(Ticks) &
ffa_ch17_peh.kv 155 " IP:" & Tape_Positions'Image(IP) & " : " & S);
ffa_ch4_ffacalc.kv 156 end E;
ffa_ch4_ffacalc.kv 157
ffa_ch4_ffacalc.kv 158
ffa_ch17_peh.kv 159
ffa_ch17_peh.kv 160
ffa_ch17_peh.kv 161
ffa_ch17_peh.kv 162
ffa_ch17_peh.kv 163
ffa_ch17_peh.kv 164 procedure Control_Push(Position : in Tape_Positions) is
ffa_ch17_peh.kv 165 begin
ffa_ch17_peh.kv 166
ffa_ch17_peh.kv 167 if CSP = Control_Stack'Last then
ffa_ch17_peh.kv 168 E("Control Stack Overflow!");
ffa_ch17_peh.kv 169 end if;
ffa_ch17_peh.kv 170
ffa_ch17_peh.kv 171
ffa_ch17_peh.kv 172 CSP := CSP + 1;
ffa_ch17_peh.kv 173 Control_Stack(CSP) := Position;
ffa_ch17_peh.kv 174 end Control_Push;
ffa_ch17_peh.kv 175
ffa_ch17_peh.kv 176
ffa_ch17_peh.kv 177
ffa_ch17_peh.kv 178 function Control_Pop return Tape_Positions is
ffa_ch17_peh.kv 179 Position : Tape_Positions;
ffa_ch17_peh.kv 180 begin
ffa_ch17_peh.kv 181
ffa_ch17_peh.kv 182 if CSP = Control_Stack'First then
ffa_ch17_peh.kv 183 E("Control Stack Underflow!");
ffa_ch17_peh.kv 184 end if;
ffa_ch17_peh.kv 185
ffa_ch17_peh.kv 186
ffa_ch17_peh.kv 187 Position := Control_Stack(CSP);
ffa_ch17_peh.kv 188 Control_Stack(CSP) := Tape_Positions'First;
ffa_ch17_peh.kv 189 CSP := CSP - 1;
ffa_ch17_peh.kv 190 return Position;
ffa_ch17_peh.kv 191 end Control_Pop;
ffa_ch17_peh.kv 192
ffa_ch17_peh.kv 193
ffa_ch17_peh.kv 194
ffa_ch17_peh.kv 195
ffa_ch17_peh.kv 196
ffa_ch17_peh.kv 197
ffa_ch4_ffacalc.kv 198
ffa_ch4_ffacalc.kv 199 procedure Push is
ffa_ch4_ffacalc.kv 200 begin
ffa_ch4_ffacalc.kv 201 if SP = Stack_Positions'Last then
ffa_ch4_ffacalc.kv 202 E("Stack Overflow!");
ffa_ch4_ffacalc.kv 203 else
ffa_ch4_ffacalc.kv 204 SP := SP + 1;
ffa_ch4_ffacalc.kv 205 end if;
ffa_ch4_ffacalc.kv 206 end Push;
ffa_ch4_ffacalc.kv 207
ffa_ch4_ffacalc.kv 208
ffa_ch4_ffacalc.kv 209
ffa_ch4_ffacalc.kv 210 procedure Drop is
ffa_ch4_ffacalc.kv 211 begin
ffa_ch11_tuning_a... 212 FFA_FZ_Clear(Stack(SP));
ffa_ch4_ffacalc.kv 213 SP := SP - 1;
ffa_ch4_ffacalc.kv 214 end Drop;
ffa_ch4_ffacalc.kv 215
ffa_ch4_ffacalc.kv 216
ffa_ch4_ffacalc.kv 217
ffa_ch4_ffacalc.kv 218 procedure Want(N : in Positive) is
ffa_ch4_ffacalc.kv 219 begin
ffa_ch4_ffacalc.kv 220 if SP < N then
ffa_ch4_ffacalc.kv 221 E("Stack Underflow!");
ffa_ch4_ffacalc.kv 222 end if;
ffa_ch4_ffacalc.kv 223 end Want;
ffa_ch4_ffacalc.kv 224
ffa_ch4_ffacalc.kv 225
ffa_ch5_egypt.kv 226
ffa_ch5_egypt.kv 227 procedure MustNotZero(D : in FZ) is
ffa_ch5_egypt.kv 228 begin
ffa_ch11_tuning_a... 229 if FFA_FZ_ZeroP(D) = 1 then
ffa_ch5_egypt.kv 230 E("Division by Zero!");
ffa_ch5_egypt.kv 231 end if;
ffa_ch5_egypt.kv 232 end MustNotZero;
ffa_ch5_egypt.kv 233
ffa_ch5_egypt.kv 234
ffa_ch4_ffacalc.kv 235
ffa_ch11_tuning_a... 236 procedure Ins_Hex_Digit(Digit : in Nibble) is
ffa_ch11_tuning_a... 237 Overflow : WBool := 0;
ffa_ch4_ffacalc.kv 238 begin
ffa_ch11_tuning_a... 239
ffa_ch11_tuning_a... 240
ffa_ch11_tuning_a... 241 FFA_FZ_Insert_Bottom_Nibble(N => Stack(SP),
ffa_ch11_tuning_a... 242 D => Digit,
ffa_ch11_tuning_a... 243 Overflow => Overflow);
ffa_ch4_ffacalc.kv 244
ffa_ch4_ffacalc.kv 245
ffa_ch11_tuning_a... 246 if Overflow = 1 then
ffa_ch4_ffacalc.kv 247 E("Constant Exceeds Bitness!");
ffa_ch4_ffacalc.kv 248 end if;
ffa_ch4_ffacalc.kv 249
ffa_ch4_ffacalc.kv 250 end;
ffa_ch4_ffacalc.kv 251
ffa_ch4_ffacalc.kv 252
ffa_ch11_tuning_a... 253
ffa_ch11_tuning_a... 254 procedure Print_FZ(N : in FZ) is
ffa_ch11_tuning_a... 255 S : String(1 .. FFA_FZ_ASCII_Length(N));
ffa_ch11_tuning_a... 256 begin
ffa_ch11_tuning_a... 257 FFA_FZ_To_Hex_String(N, S);
ffa_ch11_tuning_a... 258 Write_String(S);
ffa_ch11_tuning_a... 259 Write_Newline;
ffa_ch11_tuning_a... 260 end Print_FZ;
ffa_ch11_tuning_a... 261
ffa_ch11_tuning_a... 262
ffa_ch17_peh.kv 263
ffa_ch17_peh.kv 264 procedure Print_Trace is
ffa_ch13_measure_... 265 begin
ffa_ch17_peh.kv 266
ffa_ch17_peh.kv 267 Write_String("Data Stack:");
ffa_ch17_peh.kv 268 Write_Newline;
ffa_ch17_peh.kv 269 for i in reverse Stack'First + 1 .. SP loop
ffa_ch17_peh.kv 270 Write_String(" " & Stack_Positions'Image(i) & " : ");
ffa_ch17_peh.kv 271 Print_FZ(Stack(i));
ffa_ch17_peh.kv 272 end loop;
ffa_ch17_peh.kv 273
ffa_ch17_peh.kv 274
ffa_ch17_peh.kv 275 Write_String("Control Stack:");
ffa_ch17_peh.kv 276 Write_Newline;
ffa_ch17_peh.kv 277 for i in reverse Control_Stack'First + 1 .. CSP loop
ffa_ch17_peh.kv 278 Write_String(" " & ControlStack_Range'Image(i) & " :"
ffa_ch17_peh.kv 279 & Tape_Positions'Image(Control_Stack(i)));
ffa_ch17_peh.kv 280 Write_Newline;
ffa_ch17_peh.kv 281 end loop;
ffa_ch17_peh.kv 282
ffa_ch17_peh.kv 283
ffa_ch17_peh.kv 284 Write_String("Registers:");
ffa_ch17_peh.kv 285 Write_Newline;
ffa_ch17_peh.kv 286 for r in RegNames'Range loop
ffa_ch17_peh.kv 287 Write_String(" " & r & " : ");
ffa_ch17_peh.kv 288 Print_FZ(Registers(r));
ffa_ch17_peh.kv 289 end loop;
ffa_ch17_peh.kv 290
ffa_ch17_peh.kv 291
ffa_ch17_peh.kv 292 Write_String("Ticks :" & Natural'Image(Ticks));
ffa_ch17_peh.kv 293 Write_Newline;
ffa_ch17_peh.kv 294 Write_String("IP :" & Tape_Positions'Image(IP));
ffa_ch17_peh.kv 295 Write_Newline;
ffa_ch17_peh.kv 296 end Print_Trace;
ffa_ch13_measure_... 297
ffa_ch13_measure_... 298
ffa_ch4_ffacalc.kv 299
ffa_ch4_ffacalc.kv 300 procedure Op_Normal(C : in Character) is
ffa_ch4_ffacalc.kv 301
ffa_ch4_ffacalc.kv 302
ffa_ch4_ffacalc.kv 303 F : Word;
ffa_ch4_ffacalc.kv 304
ffa_ch4_ffacalc.kv 305 begin
ffa_ch4_ffacalc.kv 306
ffa_ch4_ffacalc.kv 307 case C is
ffa_ch4_ffacalc.kv 308
ffa_ch4_ffacalc.kv 309
ffa_ch4_ffacalc.kv 310
ffa_ch4_ffacalc.kv 311
ffa_ch4_ffacalc.kv 312
ffa_ch4_ffacalc.kv 313 when '(' =>
ffa_ch4_ffacalc.kv 314 CommLevel := 1;
ffa_ch4_ffacalc.kv 315
ffa_ch4_ffacalc.kv 316
ffa_ch4_ffacalc.kv 317 when ')' =>
ffa_ch4_ffacalc.kv 318 E("Mismatched close-comment parenthesis !");
ffa_ch4_ffacalc.kv 319
ffa_ch4_ffacalc.kv 320
ffa_ch4_ffacalc.kv 321 when '[' =>
ffa_ch4_ffacalc.kv 322 QuoteLevel := 1;
ffa_ch4_ffacalc.kv 323
ffa_ch4_ffacalc.kv 324
ffa_ch4_ffacalc.kv 325 when ']' =>
ffa_ch4_ffacalc.kv 326 E("Mismatched close-quote bracket !");
ffa_ch4_ffacalc.kv 327
ffa_ch4_ffacalc.kv 328
ffa_ch4_ffacalc.kv 329 when '{' =>
ffa_ch4_ffacalc.kv 330 Want(1);
ffa_ch11_tuning_a... 331 if FFA_FZ_ZeroP(Stack(SP)) = 1 then
ffa_ch4_ffacalc.kv 332 CondLevel := 1;
ffa_ch4_ffacalc.kv 333 end if;
ffa_ch4_ffacalc.kv 334 Drop;
ffa_ch4_ffacalc.kv 335
ffa_ch4_ffacalc.kv 336
ffa_ch4_ffacalc.kv 337
ffa_ch4_ffacalc.kv 338 when '}' =>
ffa_ch4_ffacalc.kv 339 Push;
ffa_ch11_tuning_a... 340 FFA_WBool_To_FZ(0, Stack(SP));
ffa_ch4_ffacalc.kv 341
ffa_ch4_ffacalc.kv 342
ffa_ch4_ffacalc.kv 343
ffa_ch4_ffacalc.kv 344
ffa_ch4_ffacalc.kv 345
ffa_ch4_ffacalc.kv 346
ffa_ch4_ffacalc.kv 347
ffa_ch4_ffacalc.kv 348
ffa_ch4_ffacalc.kv 349 when '0' .. '9' =>
ffa_ch4_ffacalc.kv 350 Want(1);
ffa_ch11_tuning_a... 351 Ins_Hex_Digit(Character'Pos(C) - Character'Pos('0'));
ffa_ch4_ffacalc.kv 352
ffa_ch4_ffacalc.kv 353 when 'A' .. 'F' =>
ffa_ch4_ffacalc.kv 354 Want(1);
ffa_ch11_tuning_a... 355 Ins_Hex_Digit(10 + Character'Pos(C) - Character'Pos('A'));
ffa_ch4_ffacalc.kv 356
ffa_ch4_ffacalc.kv 357 when 'a' .. 'f' =>
ffa_ch4_ffacalc.kv 358 Want(1);
ffa_ch11_tuning_a... 359 Ins_Hex_Digit(10 + Character'Pos(C) - Character'Pos('a'));
ffa_ch4_ffacalc.kv 360
ffa_ch17_peh.kv 361
ffa_ch17_peh.kv 362
ffa_ch17_peh.kv 363
ffa_ch17_peh.kv 364 when 'g' .. 'z' =>
ffa_ch17_peh.kv 365 Push;
ffa_ch17_peh.kv 366 Stack(SP) := Registers(C);
ffa_ch17_peh.kv 367
ffa_ch4_ffacalc.kv 368
ffa_ch4_ffacalc.kv 369
ffa_ch4_ffacalc.kv 370
ffa_ch4_ffacalc.kv 371
ffa_ch4_ffacalc.kv 372
ffa_ch4_ffacalc.kv 373 when '.' =>
ffa_ch4_ffacalc.kv 374 Push;
ffa_ch11_tuning_a... 375 FFA_FZ_Clear(Stack(SP));
ffa_ch4_ffacalc.kv 376
ffa_ch4_ffacalc.kv 377
ffa_ch4_ffacalc.kv 378 when '"' =>
ffa_ch4_ffacalc.kv 379 Want(1);
ffa_ch4_ffacalc.kv 380 Push;
ffa_ch4_ffacalc.kv 381 Stack(SP) := Stack(SP - 1);
ffa_ch4_ffacalc.kv 382
ffa_ch4_ffacalc.kv 383
ffa_ch4_ffacalc.kv 384 when '_' =>
ffa_ch4_ffacalc.kv 385 Want(1);
ffa_ch4_ffacalc.kv 386 Drop;
ffa_ch4_ffacalc.kv 387
ffa_ch4_ffacalc.kv 388
ffa_ch4_ffacalc.kv 389 when ''' =>
ffa_ch4_ffacalc.kv 390 Want(2);
ffa_ch11_tuning_a... 391 FFA_FZ_Swap(Stack(SP), Stack(SP - 1));
ffa_ch4_ffacalc.kv 392
ffa_ch4_ffacalc.kv 393
ffa_ch4_ffacalc.kv 394 when '`' =>
ffa_ch4_ffacalc.kv 395 Want(2);
ffa_ch4_ffacalc.kv 396 Push;
ffa_ch4_ffacalc.kv 397 Stack(SP) := Stack(SP - 2);
ffa_ch4_ffacalc.kv 398
ffa_ch4_ffacalc.kv 399
ffa_ch4_ffacalc.kv 400
ffa_ch4_ffacalc.kv 401
ffa_ch4_ffacalc.kv 402
ffa_ch4_ffacalc.kv 403
ffa_ch4_ffacalc.kv 404 when '=' =>
ffa_ch4_ffacalc.kv 405 Want(2);
ffa_ch11_tuning_a... 406 FFA_WBool_To_FZ(FFA_FZ_EqP(X => Stack(SP),
ffa_ch11_tuning_a... 407 Y => Stack(SP - 1)),
ffa_ch11_tuning_a... 408 Stack(SP - 1));
ffa_ch4_ffacalc.kv 409 Drop;
ffa_ch4_ffacalc.kv 410
ffa_ch4_ffacalc.kv 411
ffa_ch4_ffacalc.kv 412 when '<' =>
ffa_ch4_ffacalc.kv 413 Want(2);
ffa_ch11_tuning_a... 414 FFA_WBool_To_FZ(FFA_FZ_LessThanP(X => Stack(SP - 1),
ffa_ch11_tuning_a... 415 Y => Stack(SP)),
ffa_ch11_tuning_a... 416 Stack(SP - 1));
ffa_ch4_ffacalc.kv 417 Drop;
ffa_ch4_ffacalc.kv 418
ffa_ch4_ffacalc.kv 419
ffa_ch4_ffacalc.kv 420 when '>' =>
ffa_ch4_ffacalc.kv 421 Want(2);
ffa_ch11_tuning_a... 422 FFA_WBool_To_FZ(FFA_FZ_GreaterThanP(X => Stack(SP - 1),
ffa_ch11_tuning_a... 423 Y => Stack(SP)),
ffa_ch11_tuning_a... 424 Stack(SP - 1));
ffa_ch4_ffacalc.kv 425 Drop;
ffa_ch4_ffacalc.kv 426
ffa_ch4_ffacalc.kv 427
ffa_ch4_ffacalc.kv 428
ffa_ch4_ffacalc.kv 429
ffa_ch4_ffacalc.kv 430
ffa_ch4_ffacalc.kv 431
ffa_ch4_ffacalc.kv 432 when '-' =>
ffa_ch4_ffacalc.kv 433 Want(2);
ffa_ch11_tuning_a... 434 FFA_FZ_Subtract(X => Stack(SP - 1),
ffa_ch11_tuning_a... 435 Y => Stack(SP),
ffa_ch11_tuning_a... 436 Difference => Stack(SP - 1),
ffa_ch11_tuning_a... 437 Underflow => F);
ffa_ch11_tuning_a... 438 Flag := FFA_Word_NZeroP(F);
ffa_ch4_ffacalc.kv 439 Drop;
ffa_ch4_ffacalc.kv 440
ffa_ch4_ffacalc.kv 441
ffa_ch4_ffacalc.kv 442 when '+' =>
ffa_ch4_ffacalc.kv 443 Want(2);
ffa_ch11_tuning_a... 444 FFA_FZ_Add(X => Stack(SP - 1),
ffa_ch11_tuning_a... 445 Y => Stack(SP),
ffa_ch11_tuning_a... 446 Sum => Stack(SP - 1),
ffa_ch11_tuning_a... 447 Overflow => F);
ffa_ch11_tuning_a... 448 Flag := FFA_Word_NZeroP(F);
ffa_ch4_ffacalc.kv 449 Drop;
ffa_ch4_ffacalc.kv 450
ffa_ch5_egypt.kv 451
ffa_ch5_egypt.kv 452 when '\' =>
ffa_ch5_egypt.kv 453 Want(2);
ffa_ch5_egypt.kv 454 MustNotZero(Stack(SP));
ffa_ch11_tuning_a... 455 FFA_FZ_IDiv(Dividend => Stack(SP - 1),
ffa_ch11_tuning_a... 456 Divisor => Stack(SP),
ffa_ch11_tuning_a... 457 Quotient => Stack(SP - 1),
ffa_ch11_tuning_a... 458 Remainder => Stack(SP));
ffa_ch5_egypt.kv 459
ffa_ch5_egypt.kv 460
ffa_ch5_egypt.kv 461 when '/' =>
ffa_ch5_egypt.kv 462 Want(2);
ffa_ch5_egypt.kv 463 MustNotZero(Stack(SP));
ffa_ch11_tuning_a... 464 FFA_FZ_Div(Dividend => Stack(SP - 1),
ffa_ch11_tuning_a... 465 Divisor => Stack(SP),
ffa_ch11_tuning_a... 466 Quotient => Stack(SP - 1));
ffa_ch5_egypt.kv 467 Drop;
ffa_ch5_egypt.kv 468
ffa_ch5_egypt.kv 469
ffa_ch5_egypt.kv 470 when '%' =>
ffa_ch5_egypt.kv 471 Want(2);
ffa_ch5_egypt.kv 472 MustNotZero(Stack(SP));
ffa_ch11_tuning_a... 473 FFA_FZ_Mod(Dividend => Stack(SP - 1),
ffa_ch11_tuning_a... 474 Divisor => Stack(SP),
ffa_ch11_tuning_a... 475 Remainder => Stack(SP - 1));
ffa_ch5_egypt.kv 476 Drop;
ffa_ch5_egypt.kv 477
ffa_ch5_egypt.kv 478
ffa_ch5_egypt.kv 479 when '*' =>
ffa_ch5_egypt.kv 480 Want(2);
ffa_ch11_tuning_a... 481 FFA_FZ_Multiply(X => Stack(SP - 1),
ffa_ch11_tuning_a... 482 Y => Stack(SP),
ffa_ch11_tuning_a... 483 XY_Lo => Stack(SP - 1),
ffa_ch11_tuning_a... 484 XY_Hi => Stack(SP));
ffa_ch5_egypt.kv 485
ffa_ch15_gcd.kv 486
ffa_ch15_gcd.kv 487 when 'S' =>
ffa_ch15_gcd.kv 488 Want(1);
ffa_ch15_gcd.kv 489 Push;
ffa_ch15_gcd.kv 490 FFA_FZ_Square(X => Stack(SP - 1),
ffa_ch15_gcd.kv 491 XX_Lo => Stack(SP - 1),
ffa_ch15_gcd.kv 492 XX_Hi => Stack(SP));
ffa_ch15_gcd.kv 493
ffa_ch15_gcd.kv 494
ffa_ch15_gcd.kv 495 when 'G' =>
ffa_ch15_gcd.kv 496 Want(2);
ffa_ch15_gcd.kv 497
ffa_ch15_gcd.kv 498
ffa_ch15_gcd.kv 499
ffa_ch15_gcd.kv 500
ffa_ch15_gcd.kv 501
ffa_ch15_gcd.kv 502 FFA_FZ_Greatest_Common_Divisor(X => Stack(SP - 1),
ffa_ch15_gcd.kv 503 Y => Stack(SP),
ffa_ch15_gcd.kv 504 Result => Stack(SP - 1));
ffa_ch15_gcd.kv 505 Drop;
ffa_ch15_gcd.kv 506
ffa_ch4_ffacalc.kv 507
ffa_ch4_ffacalc.kv 508
ffa_ch4_ffacalc.kv 509
ffa_ch4_ffacalc.kv 510
ffa_ch4_ffacalc.kv 511
ffa_ch4_ffacalc.kv 512 when '&' =>
ffa_ch4_ffacalc.kv 513 Want(2);
ffa_ch11_tuning_a... 514 FFA_FZ_And(X => Stack(SP - 1),
ffa_ch11_tuning_a... 515 Y => Stack(SP),
ffa_ch11_tuning_a... 516 Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv 517 Drop;
ffa_ch4_ffacalc.kv 518
ffa_ch4_ffacalc.kv 519
ffa_ch4_ffacalc.kv 520 when '|' =>
ffa_ch4_ffacalc.kv 521 Want(2);
ffa_ch11_tuning_a... 522 FFA_FZ_Or(X => Stack(SP - 1),
ffa_ch11_tuning_a... 523 Y => Stack(SP),
ffa_ch11_tuning_a... 524 Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv 525 Drop;
ffa_ch4_ffacalc.kv 526
ffa_ch4_ffacalc.kv 527
ffa_ch4_ffacalc.kv 528 when '^' =>
ffa_ch4_ffacalc.kv 529 Want(2);
ffa_ch11_tuning_a... 530 FFA_FZ_Xor(X => Stack(SP - 1),
ffa_ch11_tuning_a... 531 Y => Stack(SP),
ffa_ch11_tuning_a... 532 Result => Stack(SP - 1));
ffa_ch4_ffacalc.kv 533 Drop;
ffa_ch4_ffacalc.kv 534
ffa_ch4_ffacalc.kv 535
ffa_ch4_ffacalc.kv 536 when '~' =>
ffa_ch4_ffacalc.kv 537 Want(1);
ffa_ch11_tuning_a... 538 FFA_FZ_Not(Stack(SP), Stack(SP));
ffa_ch4_ffacalc.kv 539
ffa_ch4_ffacalc.kv 540
ffa_ch4_ffacalc.kv 541
ffa_ch4_ffacalc.kv 542
ffa_ch4_ffacalc.kv 543
ffa_ch8_randomism.kv 544
ffa_ch8_randomism.kv 545 when '?' =>
ffa_ch8_randomism.kv 546 Push;
ffa_ch11_tuning_a... 547 FFA_FZ_Clear(Stack(SP));
ffa_ch8_randomism.kv 548 FZ_Random(RNG, Stack(SP));
ffa_ch8_randomism.kv 549
ffa_ch4_ffacalc.kv 550
ffa_ch4_ffacalc.kv 551 when 'U' =>
ffa_ch4_ffacalc.kv 552 Want(3);
ffa_ch11_tuning_a... 553 FFA_FZ_Mux(X => Stack(SP - 2),
ffa_ch11_tuning_a... 554 Y => Stack(SP - 1),
ffa_ch11_tuning_a... 555 Result => Stack(SP - 2),
ffa_ch11_tuning_a... 556 Sel => FFA_FZ_NZeroP(Stack(SP)));
ffa_ch4_ffacalc.kv 557 Drop;
ffa_ch4_ffacalc.kv 558 Drop;
ffa_ch4_ffacalc.kv 559
ffa_ch13_measure_... 560
ffa_ch13_measure_... 561 when 'W' =>
ffa_ch13_measure_... 562 Want(1);
ffa_ch13_measure_... 563 declare
ffa_ch13_measure_... 564
ffa_ch14_barrett.kv 565 Measure : FZBit_Index := FFA_FZ_Measure(Stack(SP));
ffa_ch14_barrett.kv 566 begin
ffa_ch13_measure_... 567
ffa_ch13_measure_... 568 FFA_FZ_Clear(Stack(SP));
ffa_ch14_barrett.kv 569 FFA_FZ_Set_Head(Stack(SP), Word(Measure));
ffa_ch13_measure_... 570 end;
ffa_ch13_measure_... 571
ffa_ch4_ffacalc.kv 572
ffa_ch4_ffacalc.kv 573 when 'O' =>
ffa_ch4_ffacalc.kv 574 Push;
ffa_ch11_tuning_a... 575 FFA_WBool_To_FZ(Flag, Stack(SP));
ffa_ch4_ffacalc.kv 576
ffa_ch4_ffacalc.kv 577
ffa_ch4_ffacalc.kv 578 when '#' =>
ffa_ch4_ffacalc.kv 579 Want(1);
ffa_ch11_tuning_a... 580 Print_FZ(Stack(SP));
ffa_ch4_ffacalc.kv 581 Drop;
ffa_ch4_ffacalc.kv 582
ffa_ch17_peh.kv 583
ffa_ch4_ffacalc.kv 584 when 'Z' =>
ffa_ch4_ffacalc.kv 585 Zap;
ffa_ch4_ffacalc.kv 586
ffa_ch17_peh.kv 587
ffa_ch14_barrett.kv 588
ffa_ch14_barrett.kv 589 when 'V' =>
ffa_ch14_barrett.kv 590 Push;
ffa_ch14_barrett.kv 591 Push;
ffa_ch17_peh.kv 592
ffa_ch14_barrett.kv 593 FFA_FZ_Clear(Stack(SP - 1));
ffa_ch17_peh.kv 594 FFA_FZ_Set_Head(Stack(SP - 1), Word(Peh_K_Version));
ffa_ch14_barrett.kv 595
ffa_ch14_barrett.kv 596 FFA_FZ_Clear(Stack(SP));
ffa_ch14_barrett.kv 597 FFA_FZ_Set_Head(Stack(SP), Word(FFA_K_Version));
ffa_ch14_barrett.kv 598
ffa_ch16_miller_r... 599
ffa_ch16_miller_r... 600
ffa_ch16_miller_r... 601
ffa_ch16_miller_r... 602
ffa_ch16_miller_r... 603
ffa_ch16_miller_r... 604
ffa_ch16_miller_r... 605
ffa_ch16_miller_r... 606
ffa_ch16_miller_r... 607
ffa_ch16_miller_r... 608
ffa_ch16_miller_r... 609
ffa_ch16_miller_r... 610
ffa_ch16_miller_r... 611 when 'P' =>
ffa_ch16_miller_r... 612 Want(2);
ffa_ch16_miller_r... 613 declare
ffa_ch16_miller_r... 614 MR_Result : WBool :=
ffa_ch16_miller_r... 615 FFA_FZ_MR_Composite_On_Witness(N => Stack(SP - 1),
ffa_ch16_miller_r... 616 Witness => Stack(SP));
ffa_ch16_miller_r... 617 begin
ffa_ch16_miller_r... 618 FFA_WBool_To_FZ(MR_Result, Stack(SP - 1));
ffa_ch16_miller_r... 619 end;
ffa_ch16_miller_r... 620 Drop;
ffa_ch16_miller_r... 621
ffa_ch13_measure_... 622
ffa_ch13_measure_... 623
ffa_ch13_measure_... 624
ffa_ch13_measure_... 625
ffa_ch17_peh.kv 626 when
ffa_ch17_peh.kv 627 'Q'
ffa_ch17_peh.kv 628 |
ffa_ch17_peh.kv 629 'L'
ffa_ch17_peh.kv 630 |
ffa_ch17_peh.kv 631 'R'
ffa_ch17_peh.kv 632 |
ffa_ch17_peh.kv 633 'M'
ffa_ch17_peh.kv 634 |
ffa_ch17_peh.kv 635 '$'
ffa_ch17_peh.kv 636 =>
ffa_ch17_peh.kv 637 HavePrefix := True;
ffa_ch17_peh.kv 638
ffa_ch17_peh.kv 639
ffa_ch17_peh.kv 640
ffa_ch17_peh.kv 641
ffa_ch17_peh.kv 642
ffa_ch17_peh.kv 643
ffa_ch17_peh.kv 644 when ':' =>
ffa_ch17_peh.kv 645 Control_Push(IP);
ffa_ch17_peh.kv 646
ffa_ch17_peh.kv 647
ffa_ch17_peh.kv 648
ffa_ch17_peh.kv 649
ffa_ch17_peh.kv 650 when ',' =>
ffa_ch17_peh.kv 651 Want(1);
ffa_ch17_peh.kv 652 declare
ffa_ch17_peh.kv 653 Position : Tape_Positions := Control_Pop;
ffa_ch17_peh.kv 654 begin
ffa_ch17_peh.kv 655 if FFA_FZ_NZeroP(Stack(SP)) = 1 then
ffa_ch17_peh.kv 656 IP_Next := Position;
ffa_ch17_peh.kv 657 end if;
ffa_ch17_peh.kv 658 end;
ffa_ch17_peh.kv 659 Drop;
ffa_ch13_measure_... 660
ffa_ch17_peh.kv 661
ffa_ch17_peh.kv 662 when ';' =>
ffa_ch17_peh.kv 663 IP_Next := Control_Pop;
ffa_ch13_measure_... 664
ffa_ch13_measure_... 665
ffa_ch17_peh.kv 666
ffa_ch13_measure_... 667
ffa_ch17_peh.kv 668 when '!' | '@' |
ffa_ch17_peh.kv 669 'H' | 'I' | 'J' | 'K' | 'N' | 'T' | 'X' | 'Y' =>
ffa_ch13_measure_... 670
ffa_ch13_measure_... 671 E("This Operator is not defined yet: " & C);
ffa_ch12_karatsub... 672
ffa_ch12_karatsub... 673
ffa_ch4_ffacalc.kv 674
ffa_ch4_ffacalc.kv 675
ffa_ch4_ffacalc.kv 676
ffa_ch4_ffacalc.kv 677
ffa_ch13_measure_... 678
ffa_ch4_ffacalc.kv 679 when others =>
ffa_ch4_ffacalc.kv 680 null;
ffa_ch4_ffacalc.kv 681
ffa_ch4_ffacalc.kv 682 end case;
ffa_ch4_ffacalc.kv 683
ffa_ch4_ffacalc.kv 684 end Op_Normal;
ffa_ch4_ffacalc.kv 685
ffa_ch4_ffacalc.kv 686
ffa_ch13_measure_... 687
ffa_ch13_measure_... 688 procedure Op_Prefixed(Prefix : in Character;
ffa_ch13_measure_... 689 O : in Character) is
ffa_ch17_peh.kv 690
ffa_ch17_peh.kv 691
ffa_ch17_peh.kv 692 procedure Undefined_Prefix_Op is
ffa_ch17_peh.kv 693 begin
ffa_ch17_peh.kv 694 E("Undefined Prefix Op: " & Prefix & O);
ffa_ch17_peh.kv 695 end Undefined_Prefix_Op;
ffa_ch17_peh.kv 696
ffa_ch13_measure_... 697 begin
ffa_ch13_measure_... 698
ffa_ch17_peh.kv 699
ffa_ch13_measure_... 700 case Prefix is
ffa_ch13_measure_... 701
ffa_ch13_measure_... 702
ffa_ch17_peh.kv 703
ffa_ch17_peh.kv 704 when 'Q' =>
ffa_ch17_peh.kv 705
ffa_ch17_peh.kv 706
ffa_ch17_peh.kv 707 case O is
ffa_ch17_peh.kv 708
ffa_ch17_peh.kv 709
ffa_ch17_peh.kv 710 when 'Y' =>
ffa_ch17_peh.kv 711 Verdict := Yes;
ffa_ch17_peh.kv 712
ffa_ch17_peh.kv 713
ffa_ch17_peh.kv 714 when 'N' =>
ffa_ch17_peh.kv 715 Verdict := No;
ffa_ch17_peh.kv 716
ffa_ch17_peh.kv 717
ffa_ch17_peh.kv 718 when 'M' =>
ffa_ch17_peh.kv 719 IP_Next := IP;
ffa_ch17_peh.kv 720
ffa_ch17_peh.kv 721
ffa_ch17_peh.kv 722 when 'D' =>
ffa_ch17_peh.kv 723 Print_Trace;
ffa_ch17_peh.kv 724 IP_Next := IP;
ffa_ch17_peh.kv 725
ffa_ch17_peh.kv 726
ffa_ch17_peh.kv 727
ffa_ch17_peh.kv 728
ffa_ch17_peh.kv 729
ffa_ch17_peh.kv 730
ffa_ch17_peh.kv 731
ffa_ch17_peh.kv 732
ffa_ch17_peh.kv 733
ffa_ch17_peh.kv 734
ffa_ch17_peh.kv 735
ffa_ch17_peh.kv 736
ffa_ch17_peh.kv 737 when 'E' =>
ffa_ch17_peh.kv 738
ffa_ch17_peh.kv 739 E("Tape-triggered CATASTROPHIC ERROR! " &
ffa_ch17_peh.kv 740 "Your iron and/or your build of Peh, " &
ffa_ch17_peh.kv 741 "may be defective! Please consult " &
ffa_ch17_peh.kv 742 "the author of this Tape.");
ffa_ch17_peh.kv 743
ffa_ch17_peh.kv 744
ffa_ch17_peh.kv 745 when others =>
ffa_ch17_peh.kv 746 Undefined_Prefix_Op;
ffa_ch17_peh.kv 747
ffa_ch17_peh.kv 748 end case;
ffa_ch17_peh.kv 749
ffa_ch17_peh.kv 750
ffa_ch17_peh.kv 751
ffa_ch17_peh.kv 752 when '$' =>
ffa_ch17_peh.kv 753
ffa_ch17_peh.kv 754
ffa_ch17_peh.kv 755 if O not in RegNames then
ffa_ch17_peh.kv 756 E("There is no Register '" & O & "' !");
ffa_ch17_peh.kv 757 end if;
ffa_ch17_peh.kv 758
ffa_ch17_peh.kv 759
ffa_ch17_peh.kv 760 Want(1);
ffa_ch17_peh.kv 761 Registers(O) := Stack(SP);
ffa_ch17_peh.kv 762 Drop;
ffa_ch17_peh.kv 763
ffa_ch17_peh.kv 764
ffa_ch13_measure_... 765
ffa_ch13_measure_... 766 when 'L' =>
ffa_ch13_measure_... 767
ffa_ch13_measure_... 768
ffa_ch13_measure_... 769 case O is
ffa_ch13_measure_... 770
ffa_ch13_measure_... 771
ffa_ch13_measure_... 772 when 'S' =>
ffa_ch13_measure_... 773 Want(2);
ffa_ch13_measure_... 774 declare
ffa_ch13_measure_... 775
ffa_ch13_measure_... 776 ShiftCount : FZBit_Index
ffa_ch13_measure_... 777 := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_... 778 begin
ffa_ch13_measure_... 779 FFA_FZ_Quiet_ShiftLeft(N => Stack(SP - 1),
ffa_ch13_measure_... 780 ShiftedN => Stack(SP - 1),
ffa_ch13_measure_... 781 Count => ShiftCount);
ffa_ch13_measure_... 782 end;
ffa_ch13_measure_... 783 Drop;
ffa_ch13_measure_... 784
ffa_ch13_measure_... 785
ffa_ch13_measure_... 786 when 'R' =>
ffa_ch13_measure_... 787 E("Left-Rotate not yet defined!");
ffa_ch13_measure_... 788
ffa_ch17_peh.kv 789
ffa_ch13_measure_... 790 when others =>
ffa_ch17_peh.kv 791 Undefined_Prefix_Op;
ffa_ch13_measure_... 792
ffa_ch13_measure_... 793 end case;
ffa_ch13_measure_... 794
ffa_ch13_measure_... 795
ffa_ch13_measure_... 796 when 'R' =>
ffa_ch13_measure_... 797
ffa_ch13_measure_... 798
ffa_ch13_measure_... 799 case O is
ffa_ch13_measure_... 800
ffa_ch13_measure_... 801
ffa_ch13_measure_... 802 when 'S' =>
ffa_ch13_measure_... 803 Want(2);
ffa_ch13_measure_... 804 declare
ffa_ch13_measure_... 805
ffa_ch13_measure_... 806 ShiftCount : FZBit_Index
ffa_ch13_measure_... 807 := FZBit_Index(FFA_FZ_Get_Head(Stack(SP)));
ffa_ch13_measure_... 808 begin
ffa_ch13_measure_... 809 FFA_FZ_Quiet_ShiftRight(N => Stack(SP - 1),
ffa_ch13_measure_... 810 ShiftedN => Stack(SP - 1),
ffa_ch13_measure_... 811 Count => ShiftCount);
ffa_ch13_measure_... 812 end;
ffa_ch13_measure_... 813 Drop;
ffa_ch13_measure_... 814
ffa_ch13_measure_... 815
ffa_ch13_measure_... 816 when 'R' =>
ffa_ch13_measure_... 817 E("Right-Rotate not yet defined!");
ffa_ch13_measure_... 818
ffa_ch15_gcd.kv 819
ffa_ch15_gcd.kv 820 when '*' =>
ffa_ch15_gcd.kv 821 Want(2);
ffa_ch15_gcd.kv 822 FFA_FZ_Low_Multiply(X => Stack(SP - 1),
ffa_ch15_gcd.kv 823 Y => Stack(SP),
ffa_ch15_gcd.kv 824 XY => Stack(SP - 1));
ffa_ch15_gcd.kv 825 Drop;
ffa_ch15_gcd.kv 826
ffa_ch17_peh.kv 827
ffa_ch13_measure_... 828 when others =>
ffa_ch17_peh.kv 829 Undefined_Prefix_Op;
ffa_ch13_measure_... 830
ffa_ch13_measure_... 831 end case;
ffa_ch13_measure_... 832
ffa_ch15_gcd.kv 833
ffa_ch13_measure_... 834 when 'M' =>
ffa_ch13_measure_... 835
ffa_ch13_measure_... 836
ffa_ch13_measure_... 837 case O is
ffa_ch13_measure_... 838
ffa_ch15_gcd.kv 839
ffa_ch13_measure_... 840 when '*' =>
ffa_ch13_measure_... 841 Want(3);
ffa_ch13_measure_... 842 MustNotZero(Stack(SP));
ffa_ch13_measure_... 843 FFA_FZ_Modular_Multiply(X => Stack(SP - 2),
ffa_ch13_measure_... 844 Y => Stack(SP - 1),
ffa_ch13_measure_... 845 Modulus => Stack(SP),
ffa_ch13_measure_... 846 Product => Stack(SP - 2));
ffa_ch13_measure_... 847 Drop;
ffa_ch13_measure_... 848 Drop;
ffa_ch13_measure_... 849
ffa_ch15_gcd.kv 850
ffa_ch15_gcd.kv 851 when 'S' =>
ffa_ch15_gcd.kv 852 Want(2);
ffa_ch15_gcd.kv 853 MustNotZero(Stack(SP));
ffa_ch15_gcd.kv 854 FFA_FZ_Modular_Square(X => Stack(SP - 1),
ffa_ch15_gcd.kv 855 Modulus => Stack(SP),
ffa_ch15_gcd.kv 856 Product => Stack(SP - 1));
ffa_ch15_gcd.kv 857 Drop;
ffa_ch15_gcd.kv 858
ffa_ch15_gcd.kv 859
ffa_ch13_measure_... 860 when 'X' =>
ffa_ch13_measure_... 861 Want(3);
ffa_ch13_measure_... 862 MustNotZero(Stack(SP));
ffa_ch13_measure_... 863 FFA_FZ_Modular_Exponentiate(Base => Stack(SP - 2),
ffa_ch13_measure_... 864 Exponent => Stack(SP - 1),
ffa_ch13_measure_... 865 Modulus => Stack(SP),
ffa_ch13_measure_... 866 Result => Stack(SP - 2));
ffa_ch13_measure_... 867 Drop;
ffa_ch13_measure_... 868 Drop;
ffa_ch13_measure_... 869
ffa_ch17_peh.kv 870
ffa_ch13_measure_... 871 when others =>
ffa_ch17_peh.kv 872 Undefined_Prefix_Op;
ffa_ch13_measure_... 873
ffa_ch13_measure_... 874 end case;
ffa_ch13_measure_... 875
ffa_ch13_measure_... 876
ffa_ch13_measure_... 877 when others =>
ffa_ch13_measure_... 878 E("Undefined Prefix: " & Prefix);
ffa_ch13_measure_... 879
ffa_ch13_measure_... 880 end case;
ffa_ch13_measure_... 881
ffa_ch13_measure_... 882 end Op_Prefixed;
ffa_ch13_measure_... 883
ffa_ch13_measure_... 884
ffa_ch4_ffacalc.kv 885
ffa_ch4_ffacalc.kv 886 procedure Op(C : in Character) is
ffa_ch4_ffacalc.kv 887 begin
ffa_ch4_ffacalc.kv 888
ffa_ch4_ffacalc.kv 889
ffa_ch4_ffacalc.kv 890
ffa_ch4_ffacalc.kv 891 if CommLevel > 0 then
ffa_ch4_ffacalc.kv 892 case C is
ffa_ch4_ffacalc.kv 893 when ')' =>
ffa_ch4_ffacalc.kv 894 CommLevel := CommLevel - 1;
ffa_ch4_ffacalc.kv 895 when '(' =>
ffa_ch4_ffacalc.kv 896 CommLevel := CommLevel + 1;
ffa_ch4_ffacalc.kv 897 when others =>
ffa_ch4_ffacalc.kv 898 null;
ffa_ch4_ffacalc.kv 899 end case;
ffa_ch4_ffacalc.kv 900
ffa_ch4_ffacalc.kv 901
ffa_ch4_ffacalc.kv 902 elsif QuoteLevel > 0 then
ffa_ch4_ffacalc.kv 903 case C is
ffa_ch4_ffacalc.kv 904 when ']' =>
ffa_ch4_ffacalc.kv 905 QuoteLevel := QuoteLevel - 1;
ffa_ch4_ffacalc.kv 906 when '[' =>
ffa_ch4_ffacalc.kv 907 QuoteLevel := QuoteLevel + 1;
ffa_ch4_ffacalc.kv 908 when others =>
ffa_ch4_ffacalc.kv 909 null;
ffa_ch4_ffacalc.kv 910 end case;
ffa_ch4_ffacalc.kv 911
ffa_ch4_ffacalc.kv 912
ffa_ch4_ffacalc.kv 913 if QuoteLevel > 0 then
ffa_ch4_ffacalc.kv 914 Write_Char(C);
ffa_ch4_ffacalc.kv 915 end if;
ffa_ch4_ffacalc.kv 916
ffa_ch4_ffacalc.kv 917
ffa_ch4_ffacalc.kv 918 elsif CondLevel > 0 then
ffa_ch4_ffacalc.kv 919 case C is
ffa_ch4_ffacalc.kv 920 when '}' =>
ffa_ch4_ffacalc.kv 921 CondLevel := CondLevel - 1;
ffa_ch4_ffacalc.kv 922
ffa_ch4_ffacalc.kv 923
ffa_ch4_ffacalc.kv 924
ffa_ch4_ffacalc.kv 925 if CondLevel = 0 then
ffa_ch4_ffacalc.kv 926 Push;
ffa_ch11_tuning_a... 927 FFA_WBool_To_FZ(1, Stack(SP));
ffa_ch4_ffacalc.kv 928 end if;
ffa_ch4_ffacalc.kv 929
ffa_ch4_ffacalc.kv 930 when '{' =>
ffa_ch4_ffacalc.kv 931 CondLevel := CondLevel + 1;
ffa_ch4_ffacalc.kv 932 when others =>
ffa_ch4_ffacalc.kv 933 null;
ffa_ch4_ffacalc.kv 934 end case;
ffa_ch13_measure_... 935
ffa_ch13_measure_... 936
ffa_ch13_measure_... 937 elsif HavePrefix then
ffa_ch13_measure_... 938
ffa_ch13_measure_... 939
ffa_ch13_measure_... 940 HavePrefix := False;
ffa_ch13_measure_... 941
ffa_ch13_measure_... 942
ffa_ch13_measure_... 943 Op_Prefixed(Prefix => PrevC, O => C);
ffa_ch13_measure_... 944
ffa_ch4_ffacalc.kv 945 else
ffa_ch4_ffacalc.kv 946
ffa_ch4_ffacalc.kv 947 Op_Normal(C);
ffa_ch4_ffacalc.kv 948 end if;
ffa_ch4_ffacalc.kv 949
ffa_ch17_peh.kv 950
ffa_ch17_peh.kv 951 PrevC := C;
ffa_ch17_peh.kv 952
ffa_ch4_ffacalc.kv 953 end Op;
ffa_ch4_ffacalc.kv 954
ffa_ch4_ffacalc.kv 955 begin
ffa_ch17_peh.kv 956
ffa_ch4_ffacalc.kv 957 Zap;
ffa_ch17_peh.kv 958
ffa_ch17_peh.kv 959
ffa_ch17_peh.kv 960 IP := Tape_Positions'First;
ffa_ch17_peh.kv 961
ffa_ch4_ffacalc.kv 962 loop
ffa_ch17_peh.kv 963
ffa_ch17_peh.kv 964
ffa_ch17_peh.kv 965 if IP /= Tape_Positions'Last then
ffa_ch17_peh.kv 966
ffa_ch17_peh.kv 967
ffa_ch17_peh.kv 968 IP_Next := IP + 1;
ffa_ch17_peh.kv 969
ffa_ch4_ffacalc.kv 970 else
ffa_ch17_peh.kv 971
ffa_ch17_peh.kv 972
ffa_ch17_peh.kv 973 IP_Next := IP;
ffa_ch17_peh.kv 974
ffa_ch4_ffacalc.kv 975 end if;
ffa_ch17_peh.kv 976
ffa_ch17_peh.kv 977
ffa_ch17_peh.kv 978 Ticks := Ticks + 1;
ffa_ch17_peh.kv 979
ffa_ch17_peh.kv 980
ffa_ch17_peh.kv 981 Op(Tape(IP));
ffa_ch17_peh.kv 982
ffa_ch17_peh.kv 983
ffa_ch17_peh.kv 984 exit when
ffa_ch17_peh.kv 985 Verdict /= Mu or
ffa_ch17_peh.kv 986 IP_Next = IP or
ffa_ch17_peh.kv 987 Exhausted_Life;
ffa_ch17_peh.kv 988
ffa_ch17_peh.kv 989
ffa_ch17_peh.kv 990 IP := IP_Next;
ffa_ch17_peh.kv 991
ffa_ch4_ffacalc.kv 992 end loop;
ffa_ch17_peh.kv 993
ffa_ch17_peh.kv 994
ffa_ch17_peh.kv 995 if CommLevel > 0 then
ffa_ch17_peh.kv 996 Achtung("WARNING: Tape terminated with an unclosed Comment!");
ffa_ch17_peh.kv 997 end if;
ffa_ch17_peh.kv 998
ffa_ch17_peh.kv 999 if QuoteLevel > 0 then
ffa_ch17_peh.kv 1000 Achtung("WARNING: Tape terminated with an unclosed Quote!");
ffa_ch17_peh.kv 1001 end if;
ffa_ch17_peh.kv 1002
ffa_ch17_peh.kv 1003 if CondLevel > 0 then
ffa_ch17_peh.kv 1004 Achtung("WARNING: Tape terminated with an unclosed Conditional!");
ffa_ch17_peh.kv 1005 end if;
ffa_ch17_peh.kv 1006
ffa_ch17_peh.kv 1007
ffa_ch17_peh.kv 1008
ffa_ch17_peh.kv 1009
ffa_ch17_peh.kv 1010
ffa_ch17_peh.kv 1011 if CSP /= Control_Stack'First then
ffa_ch17_peh.kv 1012 Achtung("WARNING: Tape terminated with a non-empty Control Stack!");
ffa_ch17_peh.kv 1013 end if;
ffa_ch17_peh.kv 1014
ffa_ch17_peh.kv 1015
ffa_ch17_peh.kv 1016 Zap;
ffa_ch17_peh.kv 1017
ffa_ch17_peh.kv 1018
ffa_ch17_peh.kv 1019 return Verdict;
ffa_ch17_peh.kv 1020
ffa_ch17_peh.kv 1021 end Peh_Machine;
ffa_ch4_ffacalc.kv 1022
ffa_ch4_ffacalc.kv 1023 end FFA_Calc;