tree checksum vpatch file split hunks
all signers: asciilifeform bvt diana_coman
antecedents: ffa_ch1_genesis.kv ffa_ch3_shifts.kv
press order:
| ffa_ch1_genesis.kv | asciilifeform bvt diana_coman |
| ffa_ch2_logicals.kv | asciilifeform bvt diana_coman |
| ffa_ch3_shifts.kv | asciilifeform bvt diana_coman |
| ffa_ch4_ffacalc.kv | asciilifeform bvt diana_coman |
patch:
(0 . 0)(1 . 36)
5 ------------------------------------------------------------------------------
6 ------------------------------------------------------------------------------
7 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
8 -- --
9 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
10 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
11 -- --
12 -- You do not have, nor can you ever acquire the right to use, copy or --
13 -- distribute this software ; Should you use this software for any purpose, --
14 -- or copy and distribute it to anyone or in any manner, you are breaking --
15 -- the laws of whatever soi-disant jurisdiction, and you promise to --
16 -- continue doing so for the indefinite future. In any case, please --
17 -- always : read and understand any software ; verify any PGP signatures --
18 -- that you use - for any purpose. --
19 -- --
20 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
21 ------------------------------------------------------------------------------
22 ------------------------------------------------------------------------------
23
24 to clean:
25 gprclean
26
27 to build:
28 gprbuild
29
30 to build debug, or on crapple:
31 gprbuild -Xmode=debug
32
33
34 'libffa' will build recursively.
35
36 to run:
37 ./bin/ffa_calc WIDTH HEIGHT
38
39 WIDTH must be a... see libffa/fz_lim.ads.
40 HEIGHT must be equal to or great than 1.
-(0 . 0)(1 . 1)
45 Placeholder.
-(0 . 0)(1 . 60)
50 ------------------------------------------------------------------------------
51 ------------------------------------------------------------------------------
52 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
53 -- --
54 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
55 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
56 -- --
57 -- You do not have, nor can you ever acquire the right to use, copy or --
58 -- distribute this software ; Should you use this software for any purpose, --
59 -- or copy and distribute it to anyone or in any manner, you are breaking --
60 -- the laws of whatever soi-disant jurisdiction, and you promise to --
61 -- continue doing so for the indefinite future. In any case, please --
62 -- always : read and understand any software ; verify any PGP signatures --
63 -- that you use - for any purpose. --
64 -- --
65 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
66 ------------------------------------------------------------------------------
67 ------------------------------------------------------------------------------
68
69 with System; use System;
70
71 package body CmdLine is
72
73 -- Test if GNAT's cmdline mechanism is available
74 function Initialized return Boolean is
75 gnat_argv : System.Address;
76 pragma Import (C, gnat_argv, "gnat_argv");
77
78 begin
79 return gnat_argv /= System.Null_Address;
80 end Initialized;
81
82
83 -- Fill the provided string with the text of Number-th cmdline arg
84 procedure Get_Argument(Number : in Natural;
85 Result : out String) is
86 begin
87 if Number >= Arg_Count or (not Initialized) then
88 raise Constraint_Error;
89 end if;
90
91 declare
92 L : constant Integer := Len_Arg(Number);
93 Arg : aliased String(1 .. L);
94 begin
95 -- Will it fit into the available space?
96 if L > Result'Length then
97 raise Constraint_Error;
98 end if;
99
100 -- Get this arg string from where GNAT stowed it
101 Fill_Arg(Arg'Address, Number);
102
103 -- Copy it to Result:
104 Result := (others => ' ');
105 Result(Arg'Range) := Arg;
106 end;
107 end Get_Argument;
108
109 end CmdLine;
-(0 . 0)(1 . 45)
114 ------------------------------------------------------------------------------
115 ------------------------------------------------------------------------------
116 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
117 -- --
118 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
119 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
120 -- --
121 -- You do not have, nor can you ever acquire the right to use, copy or --
122 -- distribute this software ; Should you use this software for any purpose, --
123 -- or copy and distribute it to anyone or in any manner, you are breaking --
124 -- the laws of whatever soi-disant jurisdiction, and you promise to --
125 -- continue doing so for the indefinite future. In any case, please --
126 -- always : read and understand any software ; verify any PGP signatures --
127 -- that you use - for any purpose. --
128 -- --
129 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
130 ------------------------------------------------------------------------------
131 ------------------------------------------------------------------------------
132
133 with System;
134
135 package CmdLine is
136
137 -- IMHO this is reasonable.
138 CmdLineArg_Length : constant Positive := 256;
139
140 subtype CmdLineArg is String(1 .. CmdLineArg_Length);
141
142 function Initialized return Boolean;
143
144 function Arg_Count return Natural;
145 pragma Import(C, Arg_Count, "__gnat_arg_count");
146
147 procedure Get_Argument(Number : in Natural;
148 Result : out String);
149
150 private
151
152 procedure Fill_Arg (A : System.Address; Arg_Num : Integer);
153 pragma Import(C, Fill_Arg, "__gnat_fill_arg");
154
155 function Len_Arg (Arg_Num : Integer) return Integer;
156 pragma Import(C, Len_Arg, "__gnat_len_arg");
157
158 end CmdLine;
-(0 . 0)(1 . 479)
163 ------------------------------------------------------------------------------
164 ------------------------------------------------------------------------------
165 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
166 -- --
167 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
168 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
169 -- --
170 -- You do not have, nor can you ever acquire the right to use, copy or --
171 -- distribute this software ; Should you use this software for any purpose, --
172 -- or copy and distribute it to anyone or in any manner, you are breaking --
173 -- the laws of whatever soi-disant jurisdiction, and you promise to --
174 -- continue doing so for the indefinite future. In any case, please --
175 -- always : read and understand any software ; verify any PGP signatures --
176 -- that you use - for any purpose. --
177 -- --
178 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
179 ------------------------------------------------------------------------------
180 ------------------------------------------------------------------------------
181
182 -- Basics
183 with OS; use OS;
184 with CmdLine; use CmdLine;
185
186 -- FFA
187 with FZ_Lim; use FZ_Lim;
188 with Words; use Words;
189 with W_Pred; use W_Pred;
190 with FZ_Type; use FZ_Type;
191 with FZ_Basic; use FZ_Basic;
192 with FZ_Arith; use FZ_Arith;
193 with FZ_Cmp; use FZ_Cmp;
194 with FZ_Pred; use FZ_Pred;
195 with FZ_BitOp; use FZ_BitOp;
196 with FZ_Shift; use FZ_Shift;
197
198 -- For Output
199 with FFA_IO; use FFA_IO;
200
201
202 procedure FFA_Calc is
203
204 Width : Positive; -- Desired FFA Width
205 Height : Positive; -- Desired Height of Stack
206
207 begin
208 if Arg_Count /= 3 then
209 Eggog("Usage: ./ffa_calc WIDTH HEIGHT");
210 end if;
211
212 declare
213 Arg1 : CmdLineArg;
214 Arg2 : CmdLineArg;
215 begin
216 -- Get commandline args:
217 Get_Argument(1, Arg1); -- First arg
218 Get_Argument(2, Arg2); -- Second arg
219
220 -- Parse into Positives:
221 Width := Positive'Value(Arg1);
222 Height := Positive'Value(Arg2);
223 exception
224 when others =>
225 Eggog("Invalid arguments!");
226 end;
227
228 -- Test if proposed Width is permissible:
229 if not FZ_Valid_Bitness_P(Width) then
230 Eggog("Invalid Width: " & FZ_Validity_Rule_Doc);
231 end if;
232
233 -- The Calculator itself:
234 declare
235
236 -- The number of Words required to make a FZ of the given Bitness.
237 Wordness : Indices := Indices(Width / Bitness);
238
239 --------------------------------------------------------
240 -- State --
241 --------------------------------------------------------
242 -- The Stack:
243 subtype Stack_Positions is Natural range 0 .. Height;
244 type Stacks is array(Stack_Positions range <>) of FZ(1 .. Wordness);
245 Stack : Stacks(Stack_Positions'Range);
246
247 -- Stack Pointer:
248 SP : Stack_Positions := Stack_Positions'First;
249
250 -- Carry/Borrow Flag:
251 Flag : WBool := 0;
252
253 -- Odometer:
254 Pos : Natural := 0;
255
256 -- The current levels of the three types of nestedness:
257 QuoteLevel : Natural := 0;
258 CommLevel : Natural := 0;
259 CondLevel : Natural := 0;
260 --------------------------------------------------------
261
262
263 -- Clear the stack and set SP to bottom.
264 procedure Zap is
265 begin
266 -- Clear the stack
267 for i in Stack'Range loop
268 FZ_Clear(Stack(i));
269 end loop;
270 -- Set SP to bottom
271 SP := Stack_Positions'First;
272 -- Clear Overflow flag
273 Flag := 0;
274 end Zap;
275
276
277 -- Report a fatal error condition at the current symbol
278 procedure E(S : in String) is
279 begin
280 Eggog("Pos:" & Natural'Image(Pos) & ": " & S);
281 end E;
282
283
284 -- Move SP up
285 procedure Push is
286 begin
287 if SP = Stack_Positions'Last then
288 E("Stack Overflow!");
289 else
290 SP := SP + 1;
291 end if;
292 end Push;
293
294
295 -- Discard the top of the stack
296 procedure Drop is
297 begin
298 FZ_Clear(Stack(SP));
299 SP := SP - 1;
300 end Drop;
301
302
303 -- Check if stack has the necessary N items
304 procedure Want(N : in Positive) is
305 begin
306 if SP < N then
307 E("Stack Underflow!");
308 end if;
309 end Want;
310
311
312 -- Slide a new hex digit into the FZ on top of stack
313 procedure Ins_Hex_Digit(N : in out FZ;
314 D : in Nibble) is
315 Overflow : Word := 0;
316 begin
317 -- Make room in this FZ for one additional hex digit
318 FZ_ShiftLeft_O(N => N,
319 ShiftedN => N,
320 Count => 4,
321 Overflow => Overflow);
322
323 -- Constants which exceed the Width are forbidden:
324 if W_NZeroP(Overflow) = 1 then
325 E("Constant Exceeds Bitness!");
326 end if;
327
328 -- Set the new digit
329 FZ_Or_W(N, D);
330 end;
331
332
333 -- Execute a Normal Op
334 procedure Op_Normal(C : in Character) is
335
336 -- Over/underflow output from certain ops
337 F : Word;
338
339 begin
340
341 case C is
342
343 --------------
344 -- Stickies --
345 --------------
346 -- Enter Commented
347 when '(' =>
348 CommLevel := 1;
349
350 -- Exit Commented (but we aren't in it!)
351 when ')' =>
352 E("Mismatched close-comment parenthesis !");
353
354 -- Enter Quoted
355 when '[' =>
356 QuoteLevel := 1;
357
358 -- Exit Quoted (but we aren't in it!)
359 when ']' =>
360 E("Mismatched close-quote bracket !");
361
362 -- Enter a ~taken~ Conditional branch:
363 when '{' =>
364 Want(1);
365 if FZ_ZeroP(Stack(SP)) = 1 then
366 CondLevel := 1;
367 end if;
368 Drop;
369
370 -- Exit from a ~non-taken~ Conditional branch:
371 -- ... we push a 0, to suppress the 'else' clause
372 when '}' =>
373 Push;
374 WBool_To_FZ(0, Stack(SP));
375
376 ----------------
377 -- Immediates --
378 ----------------
379
380 -- These operate on the FZ ~currently~ at top of the stack;
381 -- and this means that the stack may NOT be empty.
382
383 when '0' .. '9' =>
384 Want(1);
385 Ins_Hex_Digit(Stack(SP),
386 Character'Pos(C) - Character'Pos('0'));
387
388 when 'A' .. 'F' =>
389 Want(1);
390 Ins_Hex_Digit(Stack(SP),
391 10 + Character'Pos(C) - Character'Pos('A'));
392
393 when 'a' .. 'f' =>
394 Want(1);
395 Ins_Hex_Digit(Stack(SP),
396 10 + Character'Pos(C) - Character'Pos('a'));
397
398 ------------------
399 -- Stack Motion --
400 ------------------
401
402 -- Push a 0 onto the stack
403 when '.' =>
404 Push;
405 FZ_Clear(Stack(SP));
406
407 -- Dup
408 when '"' =>
409 Want(1);
410 Push;
411 Stack(SP) := Stack(SP - 1);
412
413 -- Drop
414 when '_' =>
415 Want(1);
416 Drop;
417
418 -- Swap
419 when ''' =>
420 Want(2);
421 FZ_Swap(Stack(SP), Stack(SP - 1));
422
423 -- Over
424 when '`' =>
425 Want(2);
426 Push;
427 Stack(SP) := Stack(SP - 2);
428
429 ----------------
430 -- Predicates --
431 ----------------
432
433 -- Equality
434 when '=' =>
435 Want(2);
436 WBool_To_FZ(FZ_Eqp(X => Stack(SP),
437 Y => Stack(SP - 1)),
438 Stack(SP - 1));
439 Drop;
440
441 -- Less-Than
442 when '<' =>
443 Want(2);
444 WBool_To_FZ(FZ_LessThanP(X => Stack(SP - 1),
445 Y => Stack(SP)),
446 Stack(SP - 1));
447 Drop;
448
449 -- Greater-Than
450 when '>' =>
451 Want(2);
452 WBool_To_FZ(FZ_GreaterThanP(X => Stack(SP - 1),
453 Y => Stack(SP)),
454 Stack(SP - 1));
455 Drop;
456
457 ----------------
458 -- Arithmetic --
459 ----------------
460
461 -- Subtract
462 when '-' =>
463 Want(2);
464 FZ_Sub(X => Stack(SP - 1),
465 Y => Stack(SP),
466 Difference => Stack(SP - 1),
467 Underflow => F);
468 Flag := W_NZeroP(F);
469 Drop;
470
471 -- Add
472 when '+' =>
473 Want(2);
474 FZ_Add(X => Stack(SP - 1),
475 Y => Stack(SP),
476 Sum => Stack(SP - 1),
477 Overflow => F);
478 Flag := W_NZeroP(F);
479 Drop;
480
481 -----------------
482 -- Bitwise Ops --
483 -----------------
484
485 -- Bitwise-And
486 when '&' =>
487 Want(2);
488 FZ_And(X => Stack(SP - 1),
489 Y => Stack(SP),
490 Result => Stack(SP - 1));
491 Drop;
492
493 -- Bitwise-Or
494 when '|' =>
495 Want(2);
496 FZ_Or(X => Stack(SP - 1),
497 Y => Stack(SP),
498 Result => Stack(SP - 1));
499 Drop;
500
501 -- Bitwise-Xor
502 when '^' =>
503 Want(2);
504 FZ_Xor(X => Stack(SP - 1),
505 Y => Stack(SP),
506 Result => Stack(SP - 1));
507 Drop;
508
509 -- Bitwise-Not (1s-Complement)
510 when '~' =>
511 Want(1);
512 FZ_Not(Stack(SP), Stack(SP));
513
514 -----------
515 -- Other --
516 -----------
517
518 -- mUx
519 when 'U' =>
520 Want(3);
521 FZ_Mux(X => Stack(SP - 2),
522 Y => Stack(SP - 1),
523 Result => Stack(SP - 2),
524 Sel => FZ_NZeroP(Stack(SP)));
525 Drop;
526 Drop;
527
528 -- Put the Overflow flag on the stack
529 when 'O' =>
530 Push;
531 WBool_To_FZ(Flag, Stack(SP));
532
533 -- Print the FZ on the top of the stack
534 when '#' =>
535 Want(1);
536 Dump(Stack(SP));
537 Drop;
538
539 -- Zap (reset)
540 when 'Z' =>
541 Zap;
542
543 -- Quit with Stack Trace
544 when 'Q' =>
545 for I in reverse Stack'First + 1 .. SP loop
546 Dump(Stack(I));
547 end loop;
548 Quit(0);
549
550 ----------
551 -- NOPs --
552 ----------
553
554 -- Ops we have not yet spoken of -- do nothing
555 when others =>
556 null;
557
558 end case;
559
560 end Op_Normal;
561
562
563 -- Process a Symbol
564 procedure Op(C : in Character) is
565 begin
566 -- First, see whether we are in a state of nestedness:
567
568 -- ... in a Comment block:
569 if CommLevel > 0 then
570 case C is
571 when ')' => -- Drop a nesting level:
572 CommLevel := CommLevel - 1;
573 when '(' => -- Add a nesting level:
574 CommLevel := CommLevel + 1;
575 when others =>
576 null; -- Other symbols have no effect at all
577 end case;
578
579 -- ... in a Quote block:
580 elsif QuoteLevel > 0 then
581 case C is
582 when ']' => -- Drop a nesting level:
583 QuoteLevel := QuoteLevel - 1;
584 when '[' => -- Add a nesting level:
585 QuoteLevel := QuoteLevel + 1;
586 when others =>
587 null; -- Other symbols have no effect on the level
588 end case;
589
590 -- If we aren't the mode-exiting ']', print current symbol:
591 if QuoteLevel > 0 then
592 Write_Char(C);
593 end if;
594
595 --- ... in a ~taken~ Conditional branch:
596 elsif CondLevel > 0 then
597 case C is
598 when '}' => -- Drop a nesting level:
599 CondLevel := CondLevel - 1;
600
601 -- If we exited the Conditional as a result,
602 -- we push a 1 to trigger the possible 'else' clause:
603 if CondLevel = 0 then
604 Push;
605 WBool_To_FZ(1, Stack(SP));
606 end if;
607
608 when '{' => -- Add a nesting level:
609 CondLevel := CondLevel + 1;
610 when others =>
611 null; -- Other symbols have no effect on the level
612 end case;
613 else
614 -- This is a Normal Op, so proceed with the normal rules.
615 Op_Normal(C);
616 end if;
617
618 end Op;
619
620
621 -- Current Character
622 C : Character;
623
624 begin
625 -- Reset the Calculator
626 Zap;
627 -- Process characters until EOF:
628 loop
629 if Read_Char(C) then
630 -- Execute Op:
631 Op(C);
632 -- Advance Odometer
633 Pos := Pos + 1;
634 else
635 Zap;
636 Quit(0); -- if EOF, we're done
637 end if;
638 end loop;
639 end;
640
641 end FFA_Calc;
-(0 . 0)(1 . 69)
646 ------------------------------------------------------------------------------
647 ------------------------------------------------------------------------------
648 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
649 -- --
650 -- (C) 2017 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 "../libffa/ffa.gpr";
666
667 project FFA_Calc is
668
669 for Object_Dir use "obj";
670
671 type Mode_Type is ("debug", "release");
672 Mode : Mode_Type := external ("mode", "release");
673
674 for Languages use ("Ada");
675 for Source_Dirs use (".");
676 for Exec_Dir use "bin";
677 for Main use ("ffa_calc.adb");
678
679 package Compiler is
680 case Mode is
681 when "debug" =>
682 for Switches ("Ada")
683 use ("-g");
684 when "release" =>
685 for Switches ("Ada")
686 use ("-O2", "-fdump-scos", "-gnata", "-fstack-check",
687 "-fdata-sections", "-ffunction-sections");
688 end case;
689 end Compiler;
690
691 package Binder is
692 case Mode is
693 when "debug" =>
694 for Switches ("Ada")
695 use ();
696 when "release" =>
697 for Switches ("Ada")
698 use ("-static");
699 end case;
700 end Binder;
701
702 package Linker is
703 case Mode is
704 when "debug" =>
705 for Switches ("Ada")
706 use ();
707 when "release" =>
708 for Switches ("Ada")
709 use ("-Wl,--gc-sections",
710 "-static");
711 end case;
712 end Linker;
713
714 end FFA_Calc;
-(0 . 0)(1 . 65)
719 ------------------------------------------------------------------------------
720 ------------------------------------------------------------------------------
721 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
722 -- --
723 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
724 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
725 -- --
726 -- You do not have, nor can you ever acquire the right to use, copy or --
727 -- distribute this software ; Should you use this software for any purpose, --
728 -- or copy and distribute it to anyone or in any manner, you are breaking --
729 -- the laws of whatever soi-disant jurisdiction, and you promise to --
730 -- continue doing so for the indefinite future. In any case, please --
731 -- always : read and understand any software ; verify any PGP signatures --
732 -- that you use - for any purpose. --
733 -- --
734 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
735 ------------------------------------------------------------------------------
736 ------------------------------------------------------------------------------
737
738 with OS; use OS;
739
740
741 with Words; use Words;
742 with W_Shifts; use W_Shifts;
743 with FZ_Type; use FZ_Type;
744
745
746 package body FFA_IO is
747
748 -- Obtain the WChars corresponding to the given Word
749 function W_To_WChars(N : Word) return WChars is
750 H : constant array(0 .. 15) of Character := "0123456789ABCDEF";
751 W : Word := N;
752 Result : WChars;
753 begin
754 for b in WChars'Range loop -- From bottom to top:
755 Result(B) := H(Natural(W and 16#F#)); -- Get current nibble.
756 W := Shift_Right(W, 4); -- Get the next nibble.
757 end loop;
758 return Result;
759 end W_To_WChars;
760
761
762 -- Display a hex representation of W to stdout
763 procedure Dump(W : in Word) is
764 T : WChars := W_To_WChars(W);
765 begin
766 for i in reverse T'Range loop
767 Write_Char(T(i));
768 end loop;
769 end Dump;
770
771
772 -- Display a hex representation of N to stdout
773 procedure Dump(N : in FZ) is
774 begin
775 for i in reverse N'Range loop
776 Dump(N(i));
777 end loop;
778
779 -- Newline, for clarity.
780 Write_Newline;
781 end Dump;
782
783 end FFA_IO;
-(0 . 0)(1 . 37)
788 ------------------------------------------------------------------------------
789 ------------------------------------------------------------------------------
790 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
791 -- --
792 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
793 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
794 -- --
795 -- You do not have, nor can you ever acquire the right to use, copy or --
796 -- distribute this software ; Should you use this software for any purpose, --
797 -- or copy and distribute it to anyone or in any manner, you are breaking --
798 -- the laws of whatever soi-disant jurisdiction, and you promise to --
799 -- continue doing so for the indefinite future. In any case, please --
800 -- always : read and understand any software ; verify any PGP signatures --
801 -- that you use - for any purpose. --
802 -- --
803 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
804 ------------------------------------------------------------------------------
805 ------------------------------------------------------------------------------
806
807 with Words; use Words;
808 with FZ_Type; use FZ_Type;
809
810 package FFA_IO is
811
812 -- Character representation of a Word
813 type WChars is array(1 .. 2 * Byteness) of Character;
814
815 -- Obtain the WChars corresponding to the given Word
816 function W_To_WChars(N : Word) return WChars;
817
818 -- Display a hex representation of W to stdout
819 procedure Dump(W : in Word);
820
821 -- Display a hex representation of N to stdout
822 procedure Dump(N : in FZ);
823
824 end FFA_IO;
-(0 . 0)(1 . 1)
829 Placeholder.
-(0 . 0)(1 . 66)
834 ------------------------------------------------------------------------------
835 ------------------------------------------------------------------------------
836 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
837 -- --
838 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
839 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
840 -- --
841 -- You do not have, nor can you ever acquire the right to use, copy or --
842 -- distribute this software ; Should you use this software for any purpose, --
843 -- or copy and distribute it to anyone or in any manner, you are breaking --
844 -- the laws of whatever soi-disant jurisdiction, and you promise to --
845 -- continue doing so for the indefinite future. In any case, please --
846 -- always : read and understand any software ; verify any PGP signatures --
847 -- that you use - for any purpose. --
848 -- --
849 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
850 ------------------------------------------------------------------------------
851 ------------------------------------------------------------------------------
852
853 package body OS is
854
855 -- Receive a character from the TTY, and True if success (False if EOF)
856 function Read_Char(C : out Character) return Boolean is
857 i : int;
858 Result : Boolean := False;
859 begin
860 i := GetChar;
861 if i /= EOF then
862 C := Character'Val(i);
863 Result := True;
864 end if;
865 return Result;
866 end Read_Char;
867
868
869 -- Send a character to the TTY.
870 procedure Write_Char(C : in Character) is
871 R : int;
872 pragma Unreferenced(R);
873 begin
874 R := PutChar(int(Character'Pos(C)));
875 end Write_Char;
876
877
878 -- Send a Newline to the TTY.
879 procedure Write_Newline is
880 begin
881 Write_Char(Character'Val(16#A#));
882 end Write_Newline;
883
884
885 -- Exit with an error condition report.
886 procedure Eggog(M : String) is
887 begin
888 for i in 1 .. M'Length loop
889 To_Stderr(M(I));
890 end loop;
891
892 -- Emit LF
893 To_Stderr(Character'Val(16#A#));
894
895 -- Exit
896 Quit(Sadness_Code);
897 end;
898
899 end OS;
-(0 . 0)(1 . 61)
904 ------------------------------------------------------------------------------
905 ------------------------------------------------------------------------------
906 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
907 -- --
908 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
909 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
910 -- --
911 -- You do not have, nor can you ever acquire the right to use, copy or --
912 -- distribute this software ; Should you use this software for any purpose, --
913 -- or copy and distribute it to anyone or in any manner, you are breaking --
914 -- the laws of whatever soi-disant jurisdiction, and you promise to --
915 -- continue doing so for the indefinite future. In any case, please --
916 -- always : read and understand any software ; verify any PGP signatures --
917 -- that you use - for any purpose. --
918 -- --
919 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
920 ------------------------------------------------------------------------------
921 ------------------------------------------------------------------------------
922
923 with Interfaces; use Interfaces;
924 with Interfaces.C; use Interfaces.C;
925
926
927 package OS is
928
929 -- Receive a character from the TTY, and True if success (False if EOF)
930 function Read_Char(C : out Character) return Boolean;
931
932 -- Send a character to the TTY.
933 procedure Write_Char(C : in Character);
934
935 -- Send a Newline to the TTY.
936 procedure Write_Newline;
937
938 -- Exit with an error condition report.
939 procedure Eggog(M : String);
940
941 procedure Quit(Return_Code : Integer);
942 pragma Import
943 (Convention => C,
944 Entity => Quit,
945 External_Name => "exit");
946
947 private
948
949 -- POSIX stdio:
950 EOF : constant int := -1;
951
952 function GetChar return int;
953 pragma Import(C, getchar);
954
955 function PutChar(item: int) return int;
956 pragma Import(C, putchar);
957
958 -- GNATistic
959 procedure To_Stderr(C : Character);
960 pragma Import(Ada, To_Stderr, "__gnat_to_stderr_char");
961
962 Sadness_Code : constant Integer := -1;
963
964 end OS;
- 445A0EEA698AC3F75014034FD7D9E74D8253862AD5D62B77881DB9E986AB0D82D24C88FB227B12EA9C41FDFFAEBBF685A21780E42A8353CD81C74C8818C67898(34 . 6)(34 . 15)
969 pragma Inline_Always(FZ_Clear);
970
971
972 -- Set given FZ to a given truth value
973 procedure WBool_To_FZ(V : in WBool; N : out FZ) is
974 begin
975 FZ_Clear(N);
976 FZ_Set_Head(N, V);
977 end WBool_To_FZ;
978 pragma Inline_Always(WBool_To_FZ);
979
980
981 -- First word of N := Source
982 procedure FZ_Set_Head(N : out FZ; Source : in Word) is
983 begin
- 5AE6FB91AABCFB353C9C2F5CC465795BC91FED25B5A98DD9A97B06FA959380E581F3F020D18717D791C858622F94C7EC13430D6FBA2476274E0A1D5985B8CC90(28 . 6)(28 . 9)
988 -- N := 0
989 procedure FZ_Clear(N : out FZ);
990
991 -- Set given FZ to a given truth value
992 procedure WBool_To_FZ(V : in WBool; N : out FZ);
993
994 -- First word of N := Source
995 procedure FZ_Set_Head(N : out FZ; Source : in Word);
996
-(0 . 0)(1 . 46)
1001 ------------------------------------------------------------------------------
1002 ------------------------------------------------------------------------------
1003 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
1004 -- --
1005 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
1006 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
1007 -- --
1008 -- You do not have, nor can you ever acquire the right to use, copy or --
1009 -- distribute this software ; Should you use this software for any purpose, --
1010 -- or copy and distribute it to anyone or in any manner, you are breaking --
1011 -- the laws of whatever soi-disant jurisdiction, and you promise to --
1012 -- continue doing so for the indefinite future. In any case, please --
1013 -- always : read and understand any software ; verify any PGP signatures --
1014 -- that you use - for any purpose. --
1015 -- --
1016 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
1017 ------------------------------------------------------------------------------
1018 ------------------------------------------------------------------------------
1019
1020 package body FZ_Lim is
1021
1022 -- Determine if a proposed FFA Bitness is valid.
1023 function FZ_Valid_Bitness_P(B : in Positive) return Boolean is
1024 Result : Boolean := False;
1025 T : Natural := B;
1026 PopCount : Natural := 0;
1027 begin
1028 -- Supposing we meet the minimal bitness:
1029 if B >= FZ_Minimal_Bitness then
1030 while T > 0 loop
1031 if T mod 2 = 1 then
1032 PopCount := PopCount + 1;
1033 end if;
1034 T := T / 2;
1035 end loop;
1036
1037 -- Is B a power of 2?
1038 if PopCount = 1 then
1039 Result := True;
1040 end if;
1041 end if;
1042
1043 return Result;
1044 end FZ_Valid_Bitness_P;
1045
1046 end FZ_Lim;
-(0 . 0)(1 . 32)
1051 ------------------------------------------------------------------------------
1052 ------------------------------------------------------------------------------
1053 -- This file is part of 'Finite Field Arithmetic', aka 'FFA'. --
1054 -- --
1055 -- (C) 2017 Stanislav Datskovskiy ( www.loper-os.org ) --
1056 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
1057 -- --
1058 -- You do not have, nor can you ever acquire the right to use, copy or --
1059 -- distribute this software ; Should you use this software for any purpose, --
1060 -- or copy and distribute it to anyone or in any manner, you are breaking --
1061 -- the laws of whatever soi-disant jurisdiction, and you promise to --
1062 -- continue doing so for the indefinite future. In any case, please --
1063 -- always : read and understand any software ; verify any PGP signatures --
1064 -- that you use - for any purpose. --
1065 -- --
1066 -- See also http://trilema.com/2015/a-new-software-licensing-paradigm . --
1067 ------------------------------------------------------------------------------
1068 ------------------------------------------------------------------------------
1069
1070 package FZ_Lim is
1071
1072 pragma Pure;
1073
1074 FZ_Minimal_Bitness : constant Positive := 256;
1075
1076 FZ_Validity_Rule_Doc : constant String
1077 := "Must be greater than or equal to 256, and a power of 2.";
1078
1079 -- Determine if a proposed FFA Bitness is valid.
1080 function FZ_Valid_Bitness_P(B : in Positive) return Boolean;
1081
1082 end FZ_Lim;
- 0E7912475E7C658BB6371C563D6A8A95B45D22CE5A6FA9BEE0C8DDDB839A361EA7791C8A8EBFBCC8C325562A9A52E2AD66C984CCD8BBA1931B1EC4874EFBFD21(38 . 6)(38 . 14)
1087 pragma Inline_Always(FZ_ZeroP);
1088
1089
1090 -- 1 iff N != 0 (branch-free); else 0
1091 function FZ_NZeroP(N : in FZ) return WBool is
1092 begin
1093 return 1 xor FZ_ZeroP(N);
1094 end FZ_NZeroP;
1095 pragma Inline_Always(FZ_NZeroP);
1096
1097
1098 -- 1 iff N is odd
1099 function FZ_OddP(N : in FZ) return WBool is
1100 begin
- 019C293F79D46BD5C0895A0F92143884A40072B67A1E22335D96D1557C8F1F760985B5ACA1A892905791656ACDA957014E1B67A927EC0946DC1CF8AE53592BB5(32 . 6)(32 . 9)
1105 -- 1 iff N == 0 (branch-free); else 0
1106 function FZ_ZeroP(N : in FZ) return WBool;
1107
1108 -- 1 iff N != 0 (branch-free); else 0
1109 function FZ_NZeroP(N : in FZ) return WBool;
1110
1111 -- 1 iff N is odd
1112 function FZ_OddP(N : in FZ) return WBool;
1113
- 81A4BF46ABD4B92F58B791872C94193606E9847F7C232AA604F91B71412F0B9732D23BE295810596355B68B8111EF5102BB7778DCB2FE987C948490A95B49CCD(40 . 6)(40 . 9)
1118 -- The very same Word, but its only legal values are 0 and 1.
1119 subtype WBool is Word range 0 .. 1;
1120
1121 -- Word, restricted to Nibble range.
1122 subtype Nibble is Word range 0 .. 16#F#;
1123
1124 -- When we must refer to individual bit positions of a machine word:
1125 subtype WBit_Index is Natural range 0 .. Bitness - 1;
1126