tree checksum vpatch file split hunks
all signers: bvt asciilifeform diana_coman
antecedents: ffa_ch15_gcd.kv ffa_ch16_miller_rabin.kv
press order:
patch:
(15 . 3)(15 . 4)
5 555788 ffa_ch14_barrett "Barrett's Modular Reduction."
6 557938 ffa_ch15_gcd "Greatest Common Divisor."
7 560516 ffa_ch16_miller_rabin "Miller-Rabin Method."
8 567223 ffa_ch17_peh "Introduction to Peh."
- 04C162662701740CECAD1575C604EECCC461336E6E75DDE17595FDD266194FE3B408593E2F44B1C2F9AF7B2495153FAC3C7CDA0FDAC7786AFAEF34C121499FF6(30 . 7)(30 . 9)
13 'libffa' will build recursively.
14
15 to run:
16 ./bin/ffa_calc WIDTH HEIGHT
17 ./bin/peh WIDTH HEIGHT TAPESPACE LIFE [RNG]
18
19 WIDTH must be a... see libffa/fz_lim.ads.
20 HEIGHT must be equal to or great than 1.
21 TAPESPACE must be at or below the maximum set in limits.ads.
22 LIFE may be any bus-width integer (0 gives "immortal" run.)
- 772AAAF953790FBB7D7FE6AFD0BF2DEAF77988B1376A7C169FBD21F47F5AAFF6DF87B2C333B90E8CD373C11379BA4830CEDC3A48B36C26767AC7303889EF6A69(20 . 7)(20 . 6)-
27 -- Basics
28 with Version; use Version;
29 with OS; use OS;
30 with CmdLine; use CmdLine;
31
32 -- FFA
33 with FFA; use FFA;
(32 . 115)(31 . 170)
35 with FFA_RNG; use FFA_RNG;
36
37
38 procedure FFA_Calc is
39 package body FFA_Calc is
40
41 Width : Positive; -- Desired FFA Width
42 Height : Positive; -- Desired Height of Stack
43 RNG : RNG_Device; -- The active RNG device.
44
45 begin
46 if Arg_Count < 3 or Arg_Count > 4 then
47 Eggog("Usage: ./ffa_calc WIDTH HEIGHT [/dev/rng]");
48 end if;
49
50 declare
51 Arg1 : CmdLineArg;
52 Arg2 : CmdLineArg;
53 -- Ensure that requested Peh Dimensions are permissible. Terminate if not.
54 procedure Validate_Peh_Dimensions(Dimensions : in Peh_Dimensions) is
55 begin
56 -- Get commandline args:
57 Get_Argument(1, Arg1); -- First arg
58 Get_Argument(2, Arg2); -- Second arg
59
60 if Arg_Count = 4 then
61 -- RNG was specified:
62 declare
63 Arg3 : CmdLineArg;
64 begin
65 Get_Argument(3, Arg3); -- Third arg (optional)
66
67 -- Ada.Sequential_IO chokes on paths with trailing whitespace!
68 -- So we have to give it a trimmed path. But we can't use
69 -- Ada.Strings.Fixed.Trim, because it suffers from
70 -- SecondaryStackism-syphilis. Instead we are stuck doing this:
71 Init_RNG(RNG, Arg3(Arg3'First .. Len_Arg(3)));
72 end;
73 else
74 -- RNG was NOT specified:
75 Init_RNG(RNG); -- Use the machine default then
76
77 -- Test if proposed Width is permissible:
78 if not FFA_FZ_Valid_Bitness_P(Dimensions.Width) then
79 Eggog("Requested Invalid FZ Width, " & FFA_Validity_Rule_Doc);
80 end if;
81
82 -- Warn the operator if an unbounded Peh run has been requested:
83 if Dimensions.Life = 0 then
84 Achtung("WARNING: Life=0 enables UNBOUNDED run time;" &
85 " halting cannot be guaranteed!");
86 end if;
87
88 -- Parse into Positives:
89 Width := Positive'Value(Arg1);
90 Height := Positive'Value(Arg2);
91 exception
92 when others =>
93 Eggog("Invalid arguments!");
94 end;
95 end Validate_Peh_Dimensions;
96
97 -- Test if proposed Width is permissible:
98 if not FFA_FZ_Valid_Bitness_P(Width) then
99 Eggog("Invalid Width: " & FFA_Validity_Rule_Doc);
100 end if;
101
102 -- The Calculator itself:
103 declare
104 -- Start a Peh Machine with the given Dimensions and Tape; return a Verdict.
105 function Peh_Machine(Dimensions : in Peh_Dimensions;
106 Tape : in Peh_Tapes;
107 RNG : in RNG_Device) return Peh_Verdicts is
108
109 -- The number of Words required to make a FZ of the given Bitness.
110 Wordness : Indices := Indices(Width / Bitness);
111 Wordness : Indices := Indices(Dimensions.Width / Bitness);
112
113 --------------------------------------------------------
114 -- State --
115 --------------------------------------------------------
116 -- The Stack:
117 subtype Stack_Positions is Natural range 0 .. Height;
118 -- The Data Stack:
119 subtype Stack_Positions is Natural range 0 .. Dimensions.Height;
120 type Stacks is array(Stack_Positions range <>) of FZ(1 .. Wordness);
121 Stack : Stacks(Stack_Positions'Range);
122 Stack : Stacks(Stack_Positions'Range);
123
124 -- Current top of the Data Stack:
125 SP : Stack_Positions := Stack_Positions'First;
126
127 -- Valid indices into the Tape:
128 subtype Tape_Positions is Peh_Tape_Range range Tape'First .. Tape'Last;
129
130 -- Position of the CURRENT Op on the Tape:
131 IP : Tape_Positions;
132
133 -- After an Op, will contain position of NEXT op (if = to IP -> halt)
134 IP_Next : Tape_Positions;
135
136 -- Control Stack; permits bidirectional motion across the Tape:
137 Control_Stack : array(ControlStack_Range) of Tape_Positions
138 := (others => Tape_Positions'First);
139
140 -- Stack Pointer:
141 SP : Stack_Positions := Stack_Positions'First;
142 -- Current top of the Control Stack:
143 CSP : ControlStack_Range := ControlStack_Range'First;
144
145 -- Registers:
146 subtype RegNames is Character range 'g' .. 'z';
147 type RegTables is array(RegNames range <>) of FZ(1 .. Wordness);
148 Registers : RegTables(RegNames'Range);
149
150 -- Carry/Borrow Flag:
151 Flag : WBool := 0;
152 Flag : WBool := 0;
153
154 -- Odometer:
155 Pos : Natural := 0;
156 Ticks : Natural := 0;
157
158 -- The current levels of the three types of nestedness:
159 QuoteLevel : Natural := 0;
160 CommLevel : Natural := 0;
161 CondLevel : Natural := 0;
162 QuoteLevel : Natural := 0;
163 CommLevel : Natural := 0;
164 CondLevel : Natural := 0;
165
166 -- Prefixed Operators
167 PrevC : Character := ' ';
168 HavePrefix : Boolean := False;
169 PrevC : Character := ' ';
170 HavePrefix : Boolean := False;
171
172 -- Current Verdict. We run while 'Mu', tape remains, and Ticks under max.
173 Verdict : Peh_Verdicts := Mu;
174 --------------------------------------------------------
175
176
177 -- Clear the stack and set SP to bottom.
178 -- Determine whether we have reached the given limit of Life:
179 function Exhausted_Life return Boolean is
180 -- If Life = 0, we are in "immortal" mode. Otherwise mortal:
181 MustDie : Boolean :=
182 (Dimensions.Life /= 0) and (Ticks = Dimensions.Life);
183 begin
184 if MustDie then
185 Achtung("WARNING: Exhausted Life ("
186 & Natural'Image(Ticks) & " ticks )");
187 end if;
188 return MustDie;
189 end Exhausted_Life;
190
191
192 -- Clear all state, other than blocks, Control Stack, Tape and Verdict:
193 procedure Zap is
194 begin
195 -- Clear the stack
196 -- Clear the Data Stack:
197 for i in Stack'Range loop
198 FFA_FZ_Clear(Stack(i));
199 end loop;
200 -- Set SP to bottom
201 SP := Stack_Positions'First;
202 -- Clear Overflow flag
203 Flag := 0;
204 -- Clear prefix
205 HavePrefix := False;
206 PrevC := ' ';
207 -- Set SP to bottom:
208 SP := Stack_Positions'First;
209 -- Clear all Registers:
210 for r in RegNames'Range loop
211 FFA_FZ_Clear(Registers(r));
212 end loop;
213 -- Clear Overflow flag:
214 Flag := 0;
215 -- Clear prefix:
216 HavePrefix := False;
217 PrevC := ' ';
218 end Zap;
219
220
221 -- Report a fatal error condition at the current symbol
222 -- Report a fatal error condition at the current symbol.
223 -- On Unixlikes, this will also end the process and return control to OS.
224 procedure E(S : in String) is
225 begin
226 Eggog("Pos:" & Natural'Image(Pos) & ": " & S);
227 Zap; -- Jettison all resettable state!
228 Eggog("FATAL: Tick:" & Natural'Image(Ticks) &
229 " IP:" & Tape_Positions'Image(IP) & " : " & S);
230 end E;
231
232
233 -------------------
234 -- Control Stack --
235 -------------------
236
237 -- Push a given Tape Position to the Control Stack:
238 procedure Control_Push(Position : in Tape_Positions) is
239 begin
240 -- First, test for Overflow of Control Stack:
241 if CSP = Control_Stack'Last then
242 E("Control Stack Overflow!");
243 end if;
244
245 -- Push given Tape Position to Control Stack:
246 CSP := CSP + 1;
247 Control_Stack(CSP) := Position;
248 end Control_Push;
249
250
251 -- Pop a Tape Position from the Control Stack:
252 function Control_Pop return Tape_Positions is
253 Position : Tape_Positions;
254 begin
255 -- First, test for Underflow of Control Stack:
256 if CSP = Control_Stack'First then
257 E("Control Stack Underflow!");
258 end if;
259
260 -- Pop a Tape Position from Control Stack:
261 Position := Control_Stack(CSP);
262 Control_Stack(CSP) := Tape_Positions'First;
263 CSP := CSP - 1;
264 return Position;
265 end Control_Pop;
266
267
268 ----------------
269 -- Data Stack --
270 ----------------
271
272 -- Move SP up
273 procedure Push is
274 begin
(206 . 11)(260 . 40)
276 end Print_FZ;
277
278
279 -- Denote that the given op is a prefix
280 procedure IsPrefix is
281 -- Print a Debug Trace (used in 'QD')
282 procedure Print_Trace is
283 begin
284 HavePrefix := True;
285 end IsPrefix;
286 -- Print Data Stack Trace:
287 Write_String("Data Stack:");
288 Write_Newline;
289 for i in reverse Stack'First + 1 .. SP loop
290 Write_String(" " & Stack_Positions'Image(i) & " : ");
291 Print_FZ(Stack(i));
292 end loop;
293
294 -- Print Control Stack Trace:
295 Write_String("Control Stack:");
296 Write_Newline;
297 for i in reverse Control_Stack'First + 1 .. CSP loop
298 Write_String(" " & ControlStack_Range'Image(i) & " :"
299 & Tape_Positions'Image(Control_Stack(i)));
300 Write_Newline;
301 end loop;
302
303 -- Print All Registers:
304 Write_String("Registers:");
305 Write_Newline;
306 for r in RegNames'Range loop
307 Write_String(" " & r & " : ");
308 Print_FZ(Registers(r));
309 end loop;
310
311 -- Print Ticks and IP:
312 Write_String("Ticks :" & Natural'Image(Ticks));
313 Write_Newline;
314 Write_String("IP :" & Tape_Positions'Image(IP));
315 Write_Newline;
316 end Print_Trace;
317
318
319 -- Execute a Normal Op
(275 . 6)(358 . 13)
321 Want(1);
322 Ins_Hex_Digit(10 + Character'Pos(C) - Character'Pos('a'));
323
324 -------------------------
325 -- Fetch from Register --
326 -------------------------
327 when 'g' .. 'z' =>
328 Push;
329 Stack(SP) := Registers(C); -- Put value of Register on stack
330
331 ------------------
332 -- Stack Motion --
333 ------------------
(490 . 25)(580 . 18)
335 Print_FZ(Stack(SP));
336 Drop;
337
338 -- Zap (reset)
339 -- Zap (reset all resettables)
340 when 'Z' =>
341 Zap;
342
343 -- Quit with Stack Trace
344 when 'Q' =>
345 for I in reverse Stack'First + 1 .. SP loop
346 Print_FZ(Stack(I));
347 end loop;
348 Quit(0);
349
350 -- Put the FFACalc Program Version on the stack,
351 -- Put the Peh Program Version on the stack,
352 -- followed by FFA Program Version.
353 when 'V' =>
354 Push;
355 Push;
356 -- FFACalc Version:
357 -- Peh Version:
358 FFA_FZ_Clear(Stack(SP - 1));
359 FFA_FZ_Set_Head(Stack(SP - 1), Word(FFACalc_K_Version));
360 FFA_FZ_Set_Head(Stack(SP - 1), Word(Peh_K_Version));
361 -- FFA Version:
362 FFA_FZ_Clear(Stack(SP));
363 FFA_FZ_Set_Head(Stack(SP), Word(FFA_K_Version));
(540 . 24)(623 . 50)
365 -- Prefixes --
366 --------------
367
368 -- 'Left...' :
369 when 'L' =>
370 IsPrefix;
371
372 -- 'Right...' :
373 when 'R' =>
374 IsPrefix;
375 when
376 'Q' -- 'Quit...'
377 |
378 'L' -- 'Left...'
379 |
380 'R' -- 'Right...'
381 |
382 'M' -- 'Modular...'
383 |
384 '$' -- Pop top of Stack into the following Register...
385 =>
386 HavePrefix := True;
387
388 -------------------
389 -- Control Stack --
390 -------------------
391
392 -- Push current IP (i.e. of THIS Op) to Control Stack.
393 when ':' =>
394 Control_Push(IP);
395
396 -- Conditional Return: Pop top of Stack, and...
397 -- ... if ZERO: simply discard the top of the Control Stack.
398 -- ... if NONZERO: pop top of Control Stack and make it next IP.
399 when ',' =>
400 Want(1);
401 declare
402 Position : Tape_Positions := Control_Pop;
403 begin
404 if FFA_FZ_NZeroP(Stack(SP)) = 1 then
405 IP_Next := Position;
406 end if;
407 end;
408 Drop;
409
410 -- 'Modular...' :
411 when 'M' =>
412 IsPrefix;
413 -- UNconditional Return: Control Stack top popped into IP_Next.
414 when ';' =>
415 IP_Next := Control_Pop;
416
417 ---------------------------------------------------------
418 -- Reserved Ops, i.e. ones we have not defined yet: --
419 -- Reserved Ops, i.e. ones we have not defined yet: --
420 ---------------------------------------------------------
421 when '!' | '@' | '$' | ':' | ';' | ',' |
422 'H' | 'I' | 'J' | 'K' | 'N' |
423 'T' | 'X' | 'Y' =>
424 when '!' | '@' |
425 'H' | 'I' | 'J' | 'K' | 'N' | 'T' | 'X' | 'Y' =>
426
427 E("This Operator is not defined yet: " & C);
428 ---------------------------------------------------------
(578 . 12)(687 . 81)
430 -- Execute a Prefixed Op
431 procedure Op_Prefixed(Prefix : in Character;
432 O : in Character) is
433
434 -- Report an attempt to execute an undefined Prefix Op:
435 procedure Undefined_Prefix_Op is
436 begin
437 E("Undefined Prefix Op: " & Prefix & O);
438 end Undefined_Prefix_Op;
439
440 begin
441
442 -- The Prefixed Op:
443 -- Which Prefix Op?
444 case Prefix is
445
446 ---------------------------------------------------------
447 -- Quit...
448 when 'Q' =>
449
450 -- .. Quit how?
451 case O is
452
453 -- ... with a 'Yes' Verdict:
454 when 'Y' =>
455 Verdict := Yes;
456
457 -- ... with a 'No' Verdict:
458 when 'N' =>
459 Verdict := No;
460
461 -- ... with a 'Mu' Verdict: (permitted, but discouraged)
462 when 'M' =>
463 IP_Next := IP; -- Force a 'Mu' Termination
464
465 -- ... with Debug Trace, and a 'Mu' Verdict:
466 when 'D' =>
467 Print_Trace;
468 IP_Next := IP; -- Force a 'Mu' Termination
469
470 -- ... with an explicit Tape-triggered fatal EGGOG!
471 -- The 'QE' curtain call is intended strictly to signal
472 -- catastrophic (e.g. iron) failure from within a Tape
473 -- program ('cosmic ray' scenario) where a ~hardwired
474 -- mechanism~ of any kind appears to have done something
475 -- unexpected; or to abort on a failed test of the RNG;
476 -- or similar hard-stop scenarios, where either physical
477 -- iron, or basic FFA routine must be said to have failed,
478 -- and the continued use of the system itself - dangerous.
479 -- The use of 'QE' for any other purpose is discouraged;
480 -- please do not use it to indicate failed decryption etc.
481 when 'E' =>
482 -- Hard-stop with this eggog:
483 E("Tape-triggered CATASTROPHIC ERROR! " &
484 "Your iron and/or your build of Peh, " &
485 "may be defective! Please consult " &
486 "the author of this Tape.");
487
488 -- ... Unknown (Eggog):
489 when others =>
490 Undefined_Prefix_Op;
491
492 end case;
493
494 ---------------------------------------------------------
495 -- Write into Register...
496 when '$' =>
497
498 -- Eggog if operator gave us a garbage Register name:
499 if O not in RegNames then
500 E("There is no Register '" & O & "' !");
501 end if;
502
503 -- Selected Register exists; move top FZ on stack into it:
504 Want(1);
505 Registers(O) := Stack(SP);
506 Drop;
507
508 ---------------------------------------------------------
509 -- Left...
510 when 'L' =>
511
(608 . 9)(786 . 9)
513 when 'R' =>
514 E("Left-Rotate not yet defined!");
515
516 -- ... Unknown:
517 -- ... Unknown (Eggog):
518 when others =>
519 E("Undefined Op: L" & O);
520 Undefined_Prefix_Op;
521
522 end case;
523 ---------------------------------------------------------
(646 . 9)(824 . 9)
525 XY => Stack(SP - 1));
526 Drop;
527
528 -- ... Unknown:
529 -- ... Unknown (Eggog):
530 when others =>
531 E("Undefined Op: R" & O);
532 Undefined_Prefix_Op;
533
534 end case;
535 ---------------------------------------------------------
(689 . 9)(867 . 9)
537 Drop;
538 Drop;
539
540 -- ... Unknown:
541 -- ... Unknown (Eggog):
542 when others =>
543 E("Undefined Op: M" & O);
544 Undefined_Prefix_Op;
545
546 end case;
547 ---------------------------------------------------------
(769 . 29)(947 . 77)
549 Op_Normal(C);
550 end if;
551
552 -- In all cases, save the current symbol as possible prefix:
553 PrevC := C;
554
555 end Op;
556
557
558 -- Current Character
559 C : Character;
560
561 begin
562 -- Reset the Calculator
563 -- Reset all resettable state:
564 Zap;
565 -- Process characters until EOF:
566
567 -- Execution begins with the first Op on the Tape:
568 IP := Tape_Positions'First;
569
570 loop
571 if Read_Char(C) then
572 -- Execute Op:
573 Op(C);
574 -- Advance Odometer
575 Pos := Pos + 1;
576 -- Save the op for use in prefixed ops
577 PrevC := C;
578
579 -- If current Op is NOT the last Op on the Tape:
580 if IP /= Tape_Positions'Last then
581
582 -- ... then default successor of the current Op is the next one:
583 IP_Next := IP + 1;
584
585 else
586 Zap;
587 Quit(0); -- if EOF, we're done
588
589 -- ... but if no 'next' Op exists, or quit-with-Mu, we stay put:
590 IP_Next := IP; -- ... this will trigger an exit from the loop.
591
592 end if;
593
594 -- Advance Odometer for every Op (incl. prefixes, in comments, etc) :
595 Ticks := Ticks + 1;
596
597 -- Execute the Op at the current IP:
598 Op(Tape(IP));
599
600 -- Halt when...
601 exit when
602 Verdict /= Mu or -- Got a Verdict, or...
603 IP_Next = IP or -- Reached the end of the Tape, or...
604 Exhausted_Life; -- Exhausted Life.
605
606 -- We did not halt yet, so select the IP of the next Op to fetch:
607 IP := IP_Next;
608
609 end loop;
610 end;
611
612 -- Warn operator about any unclosed blocks:
613 if CommLevel > 0 then
614 Achtung("WARNING: Tape terminated with an unclosed Comment!");
615 end if;
616
617 if QuoteLevel > 0 then
618 Achtung("WARNING: Tape terminated with an unclosed Quote!");
619 end if;
620
621 if CondLevel > 0 then
622 Achtung("WARNING: Tape terminated with an unclosed Conditional!");
623 end if;
624
625 -- Warn operator if we terminated with a non-empty Control Stack.
626 -- This situation ought to be considered poor style in a Peh Tape;
627 -- for clarity, Verdicts should be returned from a place near
628 -- the visually-apparent end of a Tape. However, this is not mandatory.
629 if CSP /= Control_Stack'First then
630 Achtung("WARNING: Tape terminated with a non-empty Control Stack!");
631 end if;
632
633 -- We're done with the Tape, so clear the state:
634 Zap;
635
636 -- Return the Verdict:
637 return Verdict;
638
639 end Peh_Machine;
640
641 end FFA_Calc;
(0 . 0)(1 . 55)
646 ------------------------------------------------------------------------------
647 ------------------------------------------------------------------------------
648 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
649 -- --
650 -- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org ) --
651 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
652 -- --
653 -- You do not have, nor can you ever acquire the right to use, copy or --
654 -- distribute this software ; Should you use this software for any purpose, --
655 -- or copy and distribute it to anyone or in any manner, you are breaking --
656 -- the laws of whatever soi-disant jurisdiction, and you promise to --
657 -- continue doing so for the indefinite future. In any case, please --
658 -- always : read and understand any software ; verify any PGP signatures --
659 -- that you use - for any purpose. --
660 -- --
661 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
662 ------------------------------------------------------------------------------
663 ------------------------------------------------------------------------------
664
665 with Limits; use Limits;
666 with FFA_RNG; use FFA_RNG;
667
668
669 package FFA_Calc is
670
671 -- Peh Tapes:
672 subtype Peh_Tape_Range is Positive range 1 .. Max_Peh_TapeSpace;
673 type Peh_Tapes is array(Peh_Tape_Range range <>) of Character;
674
675 -- Possible Verdicts of a non-erroneous Peh Tape run:
676 type Peh_Verdicts is (Yes, No, Mu);
677
678 -- Operator-Selectable Spatial and Time Dimensions of a Peh Machine:
679 type Peh_Dimensions is
680 record
681 Width : Positive;
682 Height : Positive;
683 TapeSpace : Peh_Tape_Range;
684 Life : Natural;
685 end record;
686
687 -- Valid indices into the Control Stack:
688 subtype ControlStack_Range is Natural range 0 .. Peh_Control_Stack_Size;
689 -- The 'zero' position, as with the Data Stack, indicates 'emptiness'
690 -- when pointed to by CSP ( see ffa_calc.adb ) and is never accessed.
691
692 -- Ensure that requested Peh Dimensions are permissible. Terminate if not.
693 procedure Validate_Peh_Dimensions(Dimensions : in Peh_Dimensions);
694
695 -- Start a Peh Machine with the given Dimensions and Tape; return a Verdict.
696 function Peh_Machine(Dimensions : in Peh_Dimensions;
697 Tape : in Peh_Tapes;
698 RNG : in RNG_Device) return Peh_Verdicts;
699
700 end FFA_Calc;
- A09EC660D5C3F45B6277DB4CA2B27F92B5B83C40A25DD030BA87C1966DB92AD0BB0D8FB06489807C47C755B5768BE490CDE04D841FFAC4C97D817D8C47607D02(1 . 69)(0 . 0)
705 ------------------------------------------------------------------------------
706 ------------------------------------------------------------------------------
707 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
708 -- --
709 -- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org ) --
710 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
711 -- --
712 -- You do not have, nor can you ever acquire the right to use, copy or --
713 -- distribute this software ; Should you use this software for any purpose, --
714 -- or copy and distribute it to anyone or in any manner, you are breaking --
715 -- the laws of whatever soi-disant jurisdiction, and you promise to --
716 -- continue doing so for the indefinite future. In any case, please --
717 -- always : read and understand any software ; verify any PGP signatures --
718 -- that you use - for any purpose. --
719 -- --
720 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
721 ------------------------------------------------------------------------------
722 ------------------------------------------------------------------------------
723
724 with "../libffa/ffa.gpr";
725
726 project FFA_Calc is
727
728 for Object_Dir use "obj";
729
730 type Mode_Type is ("debug", "release");
731 Mode : Mode_Type := external ("mode", "release");
732
733 for Languages use ("Ada");
734 for Source_Dirs use (".");
735 for Exec_Dir use "bin";
736 for Main use ("ffa_calc.adb");
737
738 package Compiler is
739 case Mode is
740 when "debug" =>
741 for Switches ("Ada")
742 use ("-g");
743 when "release" =>
744 for Switches ("Ada")
745 use ("-O2", "-fdump-scos", "-gnata", "-fstack-check",
746 "-gnatyd", "-gnatym",
747 "-fdata-sections", "-ffunction-sections");
748 end case;
749 end Compiler;
750
751 package Binder is
752 case Mode is
753 when "debug" =>
754 for Switches ("Ada")
755 use ();
756 when "release" =>
757 for Switches ("Ada")
758 use ("-static");
759 end case;
760 end Binder;
761
762 package Linker is
763 case Mode is
764 when "debug" =>
765 for Switches ("Ada")
766 use ();
767 when "release" =>
768 for Switches ("Ada")
769 use ("-Wl,--gc-sections", "-static");
770 end case;
771 end Linker;
772
773 end FFA_Calc;
-(0 . 0)(1 . 32)
778 ------------------------------------------------------------------------------
779 ------------------------------------------------------------------------------
780 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
781 -- --
782 -- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org ) --
783 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
784 -- --
785 -- You do not have, nor can you ever acquire the right to use, copy or --
786 -- distribute this software ; Should you use this software for any purpose, --
787 -- or copy and distribute it to anyone or in any manner, you are breaking --
788 -- the laws of whatever soi-disant jurisdiction, and you promise to --
789 -- continue doing so for the indefinite future. In any case, please --
790 -- always : read and understand any software ; verify any PGP signatures --
791 -- that you use - for any purpose. --
792 -- --
793 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
794 ------------------------------------------------------------------------------
795 ------------------------------------------------------------------------------
796
797 package Limits is
798
799 -- Maximum permitted length of a Peh Tape.
800 -- Peh Tapes live on the iron stack, like everything else,
801 -- so it is not possible to promise "infinite" storage space for them.
802 Max_Peh_TapeSpace : constant Positive := 1048576; -- 1MB
803 -- Operator may enlarge this constant, but may have to adjust OS stack cap.
804 -- On small/embedded systems, it can be made smaller, as appropriate.
805
806 -- The exact height of the Peh Control Stack. This is an invariant.
807 Peh_Control_Stack_Size : constant Positive := 256;
808
809 end Limits;
- CB36806DF5808E2F409446F3FFC170C3C50285DC5B7864504A5617A617215A18CC372F74CA28F583E44A43102C61B640B55B0C6F2AE40074F6716FFAC94FE6A0(69 . 7)(69 . 18)
814 To_Stderr(Character'Val(16#A#));
815
816 -- Exit
817 Quit(Sadness_Code);
818 end;
819 Quit(Sad_Code);
820 end Eggog;
821
822 -- Warn operator re: potentially-dangerous condition.
823 procedure Achtung(M : String) is
824 begin
825 for i in 1 .. M'Length loop
826 To_Stderr(M(I));
827 end loop;
828
829 -- Emit LF
830 To_Stderr(Character'Val(16#A#));
831 end Achtung;
832
833 end OS;
- 023E91EF60D6D2FD98F527DB1CF90FD181473DD5B621E40BA9CE550E7923537DEDAC9B2F29271DE4BE0035EB34CC67424285E5E8BFFC2E2F322F01CF208D2ECB(38 . 12)(38 . 21)-
838 -- Exit with an error condition report.
839 procedure Eggog(M : String);
840
841 -- Warn operator re: potentially-dangerous condition.
842 procedure Achtung(M : String);
843
844 procedure Quit(Return_Code : Integer);
845 pragma Import
846 (Convention => C,
847 Entity => Quit,
848 External_Name => "exit");
849
850 -- Result Codes for Termination
851 Yes_Code : constant Integer := 1;
852 No_Code : constant Integer := 0;
853 Mu_Code : constant Integer := -1;
854 Sad_Code : constant Integer := -2;
855
856 private
857
858 -- POSIX stdio:
(59 . 6)(68 . 4)
860 procedure To_Stderr(C : Character);
861 pragma Import(Ada, To_Stderr, "__gnat_to_stderr_char");
862
863 Sadness_Code : constant Integer := -1;
864
865 end OS;
(0 . 0)(1 . 173)
870 ------------------------------------------------------------------------------
871 ------------------------------------------------------------------------------
872 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
873 -- --
874 -- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org ) --
875 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
876 -- --
877 -- You do not have, nor can you ever acquire the right to use, copy or --
878 -- distribute this software ; Should you use this software for any purpose, --
879 -- or copy and distribute it to anyone or in any manner, you are breaking --
880 -- the laws of whatever soi-disant jurisdiction, and you promise to --
881 -- continue doing so for the indefinite future. In any case, please --
882 -- always : read and understand any software ; verify any PGP signatures --
883 -- that you use - for any purpose. --
884 -- --
885 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
886 ------------------------------------------------------------------------------
887 ------------------------------------------------------------------------------
888
889 with OS; use OS;
890 with CmdLine; use CmdLine;
891 with FFA_RNG; use FFA_RNG;
892 with FFA_Calc; use FFA_Calc;
893
894
895 -- This is the 'main' procedure of Peh for all Unixlike OS.
896 procedure Peh is
897
898 PehDim : Peh_Dimensions; -- Operator-specified spacetime footprint.
899
900 RNG : RNG_Device; -- The selected RNG device. Peh requires a RNG.
901
902 begin
903
904 -- If a valid number of command line params was NOT given, print a likbez :
905 if Arg_Count < 5 or Arg_Count > 6 then
906 Eggog("Usage: ./peh WIDTH HEIGHT TAPESPACE LIFE [/dev/rng]");
907 end if;
908
909 declare
910 Arg1 : CmdLineArg;
911 Arg2 : CmdLineArg;
912 Arg3 : CmdLineArg;
913 Arg4 : CmdLineArg;
914 begin
915
916 -- Get commandline args:
917 Get_Argument(1, Arg1); -- First mandatory arg : Width
918 Get_Argument(2, Arg2); -- Second mandatory arg : Height
919 Get_Argument(3, Arg3); -- Third mandatory arg : TapeSpace
920 Get_Argument(4, Arg4); -- Fourth mandatory arg : Life
921
922 if Arg_Count = 6 then
923
924 -- A RNG was specified (Arg_Count includes program name itself)
925 declare
926 Arg5 : CmdLineArg;
927 begin
928 Get_Argument(5, Arg5); -- Fifth arg (optional) : RNG device
929
930 -- Ada.Sequential_IO chokes on paths with trailing whitespace!
931 -- So we have to give it a trimmed path. But we can't use
932 -- Ada.Strings.Fixed.Trim, because it suffers from
933 -- SecondaryStackism-syphilis. Instead we are stuck doing this:
934 Init_RNG(RNG, Arg5(Arg5'First .. Len_Arg(5)));
935 end;
936
937 else
938
939 -- If RNG was NOT explicitly specified:
940 Init_RNG(RNG); -- Use the machine default. The '?' Op requires a RNG.
941
942 -- Warn the operator that we are going to use the default system RNG:
943 Achtung("WARNING: The '?' command will use DEFAULT entropy source : "
944 & Default_RNG_Path & " !");
945 -- Generally, you do NOT want this, outside of noob exploration/tests.
946
947 end if;
948
949 -- Parse the four mandatory arguments into Positives:
950 PehDim.Width := Positive'Value( Arg1 );
951 PehDim.Height := Positive'Value( Arg2 );
952 PehDim.TapeSpace := Peh_Tape_Range'Value( Arg3 );
953 PehDim.Life := Natural'Value( Arg4 );
954
955 exception
956
957 -- There was an attempt to parse garbage in the init parameters:
958 when others =>
959 Eggog("Invalid arguments!");
960
961 end;
962
963 -- Validate requested Peh Dimensions. If invalid, program will terminate.
964 Validate_Peh_Dimensions(PehDim);
965
966 -- Read, from Unix 'standard input' , and then execute, the Tape:
967 declare
968
969 -- The current Tape input symbol
970 Tape_Read_Char : Character;
971
972 -- The TapeSpace
973 TapeSpace : Peh_Tapes(1 .. PehDim.TapeSpace) := (others => ' ');
974
975 -- 'End of File' condition when reading :
976 EOF : Boolean := False;
977
978 -- Will contain the Verdict produced by the Tape:
979 Verdict : Peh_Verdicts;
980
981 begin
982
983 -- Attempt to read the entire expected Tapespace length, and no more:
984 for TapePosition in TapeSpace'Range loop
985
986 -- Attempt to receive a symbol from the standard input:
987 if Read_Char(Tape_Read_Char) then
988
989 -- Save the successfully-read symbol to the TapeSpace:
990 TapeSpace(TapePosition) := Tape_Read_Char;
991
992 else
993
994 -- Got an EOF instead of a symbol:
995 EOF := True;
996 if TapePosition /= TapeSpace'Length then
997 Achtung("WARNING: Short Tape: Tapespace filled to position:" &
998 Peh_Tape_Range'Image(TapePosition) & " of" &
999 Peh_Tape_Range'Image(TapeSpace'Last) & ".");
1000 end if;
1001
1002 end if;
1003
1004 exit when EOF; -- When EOF, halt reading, and proceed to execution.
1005
1006 end loop;
1007
1008 -- Execute Peh over the given Tape, on Peh Machine with given dimensions:
1009 Verdict := Peh_Machine(Dimensions => PehDim,
1010 Tape => TapeSpace,
1011 RNG => RNG);
1012
1013 -- A correctly-written Peh Tape is expected to produce a Verdict.
1014 -- On Unix, we will give it to the caller process via the usual means:
1015 case Verdict is
1016
1017 -- Tape produced a Verdict of 'Yes' :
1018 when Yes =>
1019 Quit(Yes_Code);
1020
1021 -- Tape produced a Verdict of 'No' :
1022 when No =>
1023 Quit(No_Code);
1024
1025 -- Tape ran to completion without producing any Verdict at all.
1026 -- Outside of simple test scenarios, noob explorations, etc.,
1027 -- this usually means that there is a logical mistake in the
1028 -- Tape somewhere, and we will warn the operator:
1029 when Mu =>
1030 Achtung("WARNING: Tape terminated without a Verdict.");
1031 Quit(Mu_Code);
1032
1033 end case;
1034
1035 -- If the Tape aborted on account of a fatal error condition (e.g. div0)
1036 -- Peh will Quit(Sad_Code) (see E(..) in ffa_calc.adb .)
1037 -- Therefore, Peh ALWAYS returns one of FOUR possible Unix return-codes:
1038 -- -2, -1, 0, 1. (see os.ads .)
1039
1040 end;
1041
1042 end Peh;
-(0 . 0)(1 . 69)
1047 ------------------------------------------------------------------------------
1048 ------------------------------------------------------------------------------
1049 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
1050 -- --
1051 -- (C) 2019 Stanislav Datskovskiy ( www.loper-os.org ) --
1052 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
1053 -- --
1054 -- You do not have, nor can you ever acquire the right to use, copy or --
1055 -- distribute this software ; Should you use this software for any purpose, --
1056 -- or copy and distribute it to anyone or in any manner, you are breaking --
1057 -- the laws of whatever soi-disant jurisdiction, and you promise to --
1058 -- continue doing so for the indefinite future. In any case, please --
1059 -- always : read and understand any software ; verify any PGP signatures --
1060 -- that you use - for any purpose. --
1061 -- --
1062 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
1063 ------------------------------------------------------------------------------
1064 ------------------------------------------------------------------------------
1065
1066 with "../libffa/ffa.gpr";
1067
1068 project Peh is
1069
1070 for Object_Dir use "obj";
1071
1072 type Mode_Type is ("debug", "release");
1073 Mode : Mode_Type := external ("mode", "release");
1074
1075 for Languages use ("Ada");
1076 for Source_Dirs use (".");
1077 for Exec_Dir use "bin";
1078 for Main use ("peh.adb");
1079
1080 package Compiler is
1081 case Mode is
1082 when "debug" =>
1083 for Switches ("Ada")
1084 use ("-g");
1085 when "release" =>
1086 for Switches ("Ada")
1087 use ("-O2", "-fdump-scos", "-gnata", "-fstack-check",
1088 "-gnatyd", "-gnatym",
1089 "-fdata-sections", "-ffunction-sections");
1090 end case;
1091 end Compiler;
1092
1093 package Binder is
1094 case Mode is
1095 when "debug" =>
1096 for Switches ("Ada")
1097 use ();
1098 when "release" =>
1099 for Switches ("Ada")
1100 use ("-static");
1101 end case;
1102 end Binder;
1103
1104 package Linker is
1105 case Mode is
1106 when "debug" =>
1107 for Switches ("Ada")
1108 use ();
1109 when "release" =>
1110 for Switches ("Ada")
1111 use ("-Wl,--gc-sections", "-static");
1112 end case;
1113 end Linker;
1114
1115 end Peh;
- 7863511153DAAF0B1940927701245ECC7EC8AFF31C79B80CC6D8D90852F88FEDE9458D678B0AE8BC6C09A5D57465CA9CE4C699B3212EBD863BB41D9170E2C08F(21 . 10)(21 . 10)
1120
1121 pragma Pure;
1122
1123 ----------------------------------------------
1124 -- Current 'deg. Kelvin' Version of FFACalc --
1125 ----------------------------------------------
1126 FFACalc_K_Version : constant Natural := 253;
1127 ----------------------------------------------
1128 --------------------------------------------
1129 -- Current 'deg. Kelvin' Version of Peh --
1130 --------------------------------------------
1131 Peh_K_Version : constant Natural := 252;
1132 --------------------------------------------
1133
1134 end Version;
- 78D4C49FFCA81897F9E4832F272A46DF2DD8258BCD4502FFF7C716E4D8B7E67F5C96AEA13E193D44374FFADC7BF3487AE14C512257875D95C3414FD37C69F03A(194 . 7)(194 . 7)
1139 -- Generate Barrettoid(X) to use in all of the modulo-X operations:
1140 FZ_Make_Barrettoid(Modulus => X, Result => XBar);
1141
1142 -- Find R >= 1, and odd K, where X − 1 = 2^R * K :
1143 -- Find R >= 1, and odd K, where X - 1 = 2^R * K :
1144
1145 -- ... first, find R, the largest power of two which divides X - 1 :
1146 R := FZ_Count_Bottom_Zeros(X_Minus_One);