tree checksum vpatch file split hunks
all signers: asciilifeform
antecedents:
press order:
| cryostat_genesis.kv | asciilifeform |
patch:
(0 . 0)(1 . 1)
5 633037 cryostat_genesis "Genesis."
-(0 . 0)(1 . 93)
10 ------------------------------------------------------------------------------
11 ------------------------------------------------------------------------------
12 -- This file is part of 'Cryostat', an Ada library for persistent storage. --
13 -- --
14 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
15 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
16 -- --
17 -- You do not have, nor can you ever acquire the right to use, copy or --
18 -- distribute this software ; Should you use this software for any purpose, --
19 -- or copy and distribute it to anyone or in any manner, you are breaking --
20 -- the laws of whatever soi-disant jurisdiction, and you promise to --
21 -- continue doing so for the indefinite future. In any case, please --
22 -- always : read and understand any software ; verify any PGP signatures --
23 -- that you use - for any purpose. --
24 ------------------------------------------------------------------------------
25 ------------------------------------------------------------------------------
26
27 ------------------------------------------------------------------------------
28 "Cryostat" is a Fits-in-Head minimal library for adding persistent storage to
29 Ada data structures. It uses the MMap() system call, present in Linux (kernel
30 2.4 and newer) and all compatible operating systems.
31
32 Cryostat does NOT require enabling the use of pointerism, the secondary stack,
33 heap, or other bulky and objectionable GNAT features, in the calling program.
34 It does however require "finalization" to be enabled. This is used to
35 guarantee the safe sync-to-disk and closing of the backing MMap when the
36 data structure it contains goes out of scope.
37
38 See introductory article : http://www.loper-os.org/?p=3791
39 ------------------------------------------------------------------------------
40
41 ------------------------------------------------------------------------------
42 BUILD, TEST :
43 ------------------------------------------------------------------------------
44
45 cd demo
46 gprbuild
47 ./bin/cryodemo
48
49 Will produce this output :
50
51 T(0) before : 0
52 T(Last) before : 0
53 T(0) after : 1
54 T(Last) after : 1
55 OK.
56
57 On a second invocation :
58
59 T(0) before : 1
60 T(Last) before : 1
61 T(0) after : 2
62 T(Last) after : 2
63 OK.
64
65 ... on the N-th invocation :
66
67 T(0) before : N-1
68 T(Last) before : N-1
69 T(0) after : N
70 T(Last) after : N
71 OK.
72
73 "cryotest.bin", the demo backing file, will consist of 512 megabytes of
74 byte value N, where N is the number of times the demo has executed.
75
76 E.g. after the first execution of "cryodemo" ,
77
78 $ hexdump -C cryotest.bin
79
80 00000000 01 01 01 01 01 01 01 01 01 01 01 01 01 01 01 01 |................|
81 *
82 20000000
83
84 ------------------------------------------------------------------------------
85 TODO (as of version 633037) :
86 ------------------------------------------------------------------------------
87
88 1) Add support for offsetted maps, and for maps which do not span the entire
89 length of their backing file; likewise support runtime expansion of the
90 backing file.
91
92 2) Currently, Cryostat is C-free. However, if added a .C for pulling constants
93 from system headers, instead of the hardcoded MMap() flag values
94 currently in unix.ads, could support architectures where non-standard values
95 are used for these; in particular, MIPS32, MIPS64; and possibly others.
96 See also: http://logs.nosuchlabs.com/log/trilema/2018-10-24#1865524
97
98 3) Add support for "anonymous" (i.e. not backed to disk storage) MMap, as a
99 cleaner (when using large data structures) replacement for Ada's standard
100 heap mechanism.
101
102 ------------------------------------------------------------------------------
-(0 . 0)(1 . 1)
107 Placeholder.
-(0 . 0)(1 . 76)
112 ------------------------------------------------------------------------------
113 ------------------------------------------------------------------------------
114 -- This file is part of 'CryoDemo', a tutorial example for 'Cryostat'. --
115 -- --
116 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
117 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
118 -- --
119 -- You do not have, nor can you ever acquire the right to use, copy or --
120 -- distribute this software ; Should you use this software for any purpose, --
121 -- or copy and distribute it to anyone or in any manner, you are breaking --
122 -- the laws of whatever soi-disant jurisdiction, and you promise to --
123 -- continue doing so for the indefinite future. In any case, please --
124 -- always : read and understand any software ; verify any PGP signatures --
125 -- that you use - for any purpose. --
126 ------------------------------------------------------------------------------
127 ------------------------------------------------------------------------------
128
129 with Interfaces; use Interfaces;
130 with ada.text_io; use ada.text_io;
131
132 with Cryostat;
133
134
135 procedure CryoDemo is
136
137 -- Path on disk for the example Cryostat backing file :
138 File_Path : constant String := "cryotest.bin";
139
140 -- Now, let's define an example data structure to place in a Cryostat :
141
142 -- Example payload array's element type: byte.
143 subtype ADatum is Unsigned_8;
144
145 -- Let's make it 512MB - far bigger than a typical stack, to demonstrate
146 -- that it will in fact reside in the Cryostat, rather than on the stack :
147 A_MBytes : constant Unsigned_32 := 512;
148
149 -- Example payload: an array.
150 subtype ARange is Unsigned_32 range 0 .. (A_MBytes * 1024 * 1024) - 1;
151
152 -- Complete the definition of the payload data structure :
153 type TestArray is array(ARange) of ADatum;
154
155 -- Declare a Cryostat which stores a TestArray :
156 package Cryo is new Cryostat(Form => TestArray,
157 Path => File_Path,
158 Writable => True, -- Permit writing
159 Create => True); -- Create file if not exists
160
161 -- Handy reference to the payload; no pointerisms needed !
162 T : TestArray renames Cryo.Item;
163
164 -- T can now be treated as if it lived on the stack :
165
166 begin
167
168 Put_Line("T(0) before : " & ADatum'Image(T(0)));
169 Put_Line("T(Last) before : " & ADatum'Image(T(T'Last)));
170
171 -- Increment each of the elements of T :
172 for i in T'Range loop
173 T(i) := T(i) + 1;
174 end loop;
175
176 Put_Line("T(0) after : " & ADatum'Image(T(0)));
177 Put_Line("T(Last) after : " & ADatum'Image(T(T'Last)));
178
179 --- Optional, finalizer always syncs in this example
180 -- Cryo.Sync;
181
182 --- Test of Zap -- uncomment and get zeroized payload every time :
183 -- Cryo.Zap;
184
185 Put_Line("OK.");
186
187 end CryoDemo;
-(0 . 0)(1 . 68)
192 ------------------------------------------------------------------------------
193 ------------------------------------------------------------------------------
194 -- This file is part of 'CryoDemo', a tutorial example for 'Cryostat'. --
195 -- --
196 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
197 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
198 -- --
199 -- You do not have, nor can you ever acquire the right to use, copy or --
200 -- distribute this software ; Should you use this software for any purpose, --
201 -- or copy and distribute it to anyone or in any manner, you are breaking --
202 -- the laws of whatever soi-disant jurisdiction, and you promise to --
203 -- continue doing so for the indefinite future. In any case, please --
204 -- always : read and understand any software ; verify any PGP signatures --
205 -- that you use - for any purpose. --
206 ------------------------------------------------------------------------------
207 ------------------------------------------------------------------------------
208
209 with "../libcryo/cryostat.gpr";
210
211 project CryoDemo is
212
213 for Object_Dir use "obj";
214
215 type Mode_Type is ("debug", "release");
216 Mode : Mode_Type := external ("mode", "release");
217
218 for Languages use ("Ada");
219 for Source_Dirs use (".");
220 for Exec_Dir use "bin";
221 for Main use ("cryodemo.adb");
222
223 package Compiler is
224 case Mode is
225 when "debug" =>
226 for Switches ("Ada")
227 use ("-g");
228 when "release" =>
229 for Switches ("Ada")
230 use ("-O2", "-fdump-scos", "-gnata", "-fstack-check",
231 "-gnatyd", "-gnatym",
232 "-fdata-sections", "-ffunction-sections",
233 "-gnatec=" & CryoDemo'Project_Dir & "restrict.adc");
234 end case;
235 end Compiler;
236
237 package Binder is
238 case Mode is
239 when "debug" =>
240 for Switches ("Ada")
241 use ();
242 when "release" =>
243 for Switches ("Ada")
244 use ("-static");
245 end case;
246 end Binder;
247
248 package Linker is
249 case Mode is
250 when "debug" =>
251 for Switches ("Ada")
252 use ();
253 when "release" =>
254 for Switches ("Ada")
255 use ("-Wl,--gc-sections", "-static");
256 end case;
257 end Linker;
258
259 end CryoDemo;
-(0 . 0)(1 . 1)
264 Placeholder.
-(0 . 0)(1 . 83)
269 ------------------------------------------------------------------------------
270 ------------------------------------------------------------------------------
271 -- This file is part of 'CryoDemo', a tutorial example for 'Cryostat'. --
272 -- --
273 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
274 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
275 -- --
276 -- You do not have, nor can you ever acquire the right to use, copy or --
277 -- distribute this software ; Should you use this software for any purpose, --
278 -- or copy and distribute it to anyone or in any manner, you are breaking --
279 -- the laws of whatever soi-disant jurisdiction, and you promise to --
280 -- continue doing so for the indefinite future. In any case, please --
281 -- always : read and understand any software ; verify any PGP signatures --
282 -- that you use - for any purpose. --
283 ------------------------------------------------------------------------------
284 ------------------------------------------------------------------------------
285
286 pragma Restrictions(Immediate_Reclamation);
287 pragma Restrictions(Max_Asynchronous_Select_Nesting => 0);
288 pragma Restrictions(Max_Protected_Entries => 0);
289 pragma Restrictions(Max_Select_Alternatives => 0);
290 pragma Restrictions(Max_Task_Entries => 0);
291 pragma Restrictions(Max_Tasks => 0);
292 pragma Restrictions(No_Abort_Statements);
293 pragma Restrictions(No_Access_Parameter_Allocators);
294 pragma Restrictions(No_Allocators);
295 pragma Restrictions(No_Asynchronous_Control);
296 pragma Restrictions(No_Calendar);
297 pragma Restrictions(No_Coextensions);
298 pragma Restrictions(No_Default_Stream_Attributes);
299 pragma Restrictions(No_Delay);
300 pragma Restrictions(No_Dispatch);
301 pragma Restrictions(No_Dispatching_Calls);
302 pragma Restrictions(No_Dynamic_Attachment);
303 pragma Restrictions(No_Dynamic_Priorities);
304 pragma Restrictions(No_Entry_Calls_In_Elaboration_Code);
305 pragma Restrictions(No_Entry_Queue);
306 pragma Restrictions(No_Enumeration_Maps);
307 pragma Restrictions(No_Exception_Propagation);
308 pragma Restrictions(No_Exception_Registration);
309 pragma Restrictions(No_Fixed_Io);
310 pragma Restrictions(No_Floating_Point);
311 pragma Restrictions(No_Implementation_Aspect_Specifications);
312 pragma Restrictions(No_Implementation_Units);
313 pragma Restrictions(No_Implicit_Dynamic_Code);
314 pragma Restrictions(No_Implicit_Heap_Allocations);
315 pragma Restrictions(No_Implicit_Protected_Object_Allocations);
316 pragma Restrictions(No_Implicit_Task_Allocations);
317 pragma Restrictions(No_Initialize_Scalars);
318 pragma Restrictions(No_Local_Protected_Objects);
319 pragma Restrictions(No_Local_Timing_Events);
320 pragma Restrictions(No_Protected_Type_Allocators);
321 pragma Restrictions(No_Protected_Types);
322 pragma Restrictions(No_Relative_Delay);
323 pragma Restrictions(No_Requeue_Statements);
324 pragma Restrictions(No_Secondary_Stack);
325 pragma Restrictions(No_Select_Statements);
326 pragma Restrictions(No_Specific_Termination_Handlers);
327 pragma Restrictions(No_Standard_Allocators_After_Elaboration);
328 pragma Restrictions(No_Stream_Optimizations);
329 pragma Restrictions(No_Streams);
330 pragma Restrictions(No_Task_Allocators);
331 pragma Restrictions(No_Task_At_Interrupt_Priority);
332 pragma Restrictions(No_Task_Attributes_Package);
333 pragma Restrictions(No_Task_Hierarchy);
334 pragma Restrictions(No_Tasking);
335 pragma Restrictions(No_Task_Termination);
336 pragma Restrictions(No_Terminate_Alternatives);
337 pragma Restrictions(No_Unchecked_Access);
338 pragma Restrictions(No_Unchecked_Conversion);
339 pragma Restrictions(No_Unchecked_Deallocation);
340 pragma Restrictions(No_Wide_Characters);
341 pragma Restrictions(Pure_Barriers);
342 pragma Restrictions(Simple_Barriers);
343 pragma Restrictions(Static_Priorities);
344 pragma Restrictions(Static_Storage_Size);
345 pragma Validity_Checks(ALL_CHECKS);
346
347 ----- Deliberately omitted (we use these) :
348
349 -- pragma Restrictions(No_Finalization);
350 -- pragma Restrictions(No_Nested_Finalization);
351 -- pragma Restrictions(No_Multiple_Elaboration);
-(0 . 0)(1 . 48)
356 ------------------------------------------------------------------------------
357 ------------------------------------------------------------------------------
358 -- This file is part of 'Cryostat', an Ada library for persistent storage. --
359 -- --
360 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
361 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
362 -- --
363 -- You do not have, nor can you ever acquire the right to use, copy or --
364 -- distribute this software ; Should you use this software for any purpose, --
365 -- or copy and distribute it to anyone or in any manner, you are breaking --
366 -- the laws of whatever soi-disant jurisdiction, and you promise to --
367 -- continue doing so for the indefinite future. In any case, please --
368 -- always : read and understand any software ; verify any PGP signatures --
369 -- that you use - for any purpose. --
370 ------------------------------------------------------------------------------
371 ------------------------------------------------------------------------------
372
373 package body Cryostat is
374
375 -- Test if the Cryostat is usable
376 function IsReady return Boolean is
377 begin
378 return PMaps.IsReady(Map);
379 end IsReady;
380
381
382 -- If the Cryostat is writable, sync to disk immediately.
383 procedure Sync is
384 begin
385 PMaps.Sync(Map);
386 end Sync;
387
388
389 -- Zero the entire mapped space of the Cryostat.
390 procedure Zap is
391 begin
392 PMaps.Zap(Map);
393 end Zap;
394
395
396 -- Close the Cryostat and mark it unusable.
397 -- Normally, this is unnecessary (Finalize will do it)
398 procedure Stop is
399 begin
400 PMaps.Stop(Map);
401 end Stop;
402
403 end Cryostat;
-(0 . 0)(1 . 74)
408 ------------------------------------------------------------------------------
409 ------------------------------------------------------------------------------
410 -- This file is part of 'Cryostat', an Ada library for persistent storage. --
411 -- --
412 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
413 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
414 -- --
415 -- You do not have, nor can you ever acquire the right to use, copy or --
416 -- distribute this software ; Should you use this software for any purpose, --
417 -- or copy and distribute it to anyone or in any manner, you are breaking --
418 -- the laws of whatever soi-disant jurisdiction, and you promise to --
419 -- continue doing so for the indefinite future. In any case, please --
420 -- always : read and understand any software ; verify any PGP signatures --
421 -- that you use - for any purpose. --
422 ------------------------------------------------------------------------------
423 ------------------------------------------------------------------------------
424
425 with System;
426 with Unix; use Unix;
427 with PMaps; use PMaps;
428
429
430 generic
431
432 -- The type of the item that will live in the Cryostat :
433 type Form is limited private;
434
435 -- The path of the backing file :
436 Path : in String;
437
438 -- Whether the contents of the Cryostat will be writable :
439 Writable : in Boolean;
440
441 -- Whether the backing file is to be created if it does not already exist :
442 Create : in Boolean;
443
444 package Cryostat is
445
446 pragma Preelaborate;
447
448 -- The concrete datum of type Form that will live in the Cryostat :
449 Item : Form;
450
451 -- Test if the Cryostat is usable
452 function IsReady return Boolean;
453
454 -- If the Cryostat is writable, sync it to disk immediately
455 procedure Sync;
456
457 -- Zero the entire mapped space of the Cryostat
458 procedure Zap;
459
460 -- Close the Cryostat and mark it unusable.
461 -- Normally, this is unnecessary (Finalize will do it)
462 procedure Stop;
463
464 private
465
466 -- The actual number of bytes occupied by an instance of the Form type :
467 Footprint : constant Word := Form'Size / System.Storage_Unit;
468
469 -- Instantiate a memory map using the given params :
470 Map : PMap(Handle => OpenMapFile(Path => Path,
471 Writable => Writable,
472 Create => Create),
473 Length => Footprint,
474 Offset => 0, -- Offsetted maps not supported yet!
475 Create => Create,
476 Writable => Writable);
477
478 -- Force Item to reside at the obtained address :
479 for Item'Address use GetAddress(Map);
480
481 end Cryostat;
-(0 . 0)(1 . 63)
486 ------------------------------------------------------------------------------
487 ------------------------------------------------------------------------------
488 -- This file is part of 'Cryostat', an Ada library for persistent storage. --
489 -- --
490 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
491 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
492 -- --
493 -- You do not have, nor can you ever acquire the right to use, copy or --
494 -- distribute this software ; Should you use this software for any purpose, --
495 -- or copy and distribute it to anyone or in any manner, you are breaking --
496 -- the laws of whatever soi-disant jurisdiction, and you promise to --
497 -- continue doing so for the indefinite future. In any case, please --
498 -- always : read and understand any software ; verify any PGP signatures --
499 -- that you use - for any purpose. --
500 ------------------------------------------------------------------------------
501 ------------------------------------------------------------------------------
502
503 project Cryostat is
504
505 for Object_Dir use "obj";
506
507 type Mode_Type is ("debug", "release");
508 Mode : Mode_Type := external ("mode", "release");
509
510 for Languages use ("Ada");
511 for Source_Dirs use (".");
512 for Library_Dir use "lib";
513 for Library_Name use "Cryostat";
514 for Library_Kind use "static";
515
516 package Compiler is
517 case Mode is
518 when "debug" =>
519 for Switches ("Ada")
520 use ("-g");
521 when "release" =>
522 for Switches ("Ada")
523 use ("-O2", "-fdump-scos", "-gnata", "-fstack-check",
524 "-gnatyd", "-gnatym",
525 "-fdata-sections", "-ffunction-sections", "-gnatwr", "-gnatw.d",
526 "-gnatec=" & Cryostat'Project_Dir & "restrict.adc");
527 for Switches ("C")
528 use ("-O2", "-Wall", "-fstack-check");
529 end case;
530 end Compiler;
531
532 package Builder is
533 for Switches ("Ada")
534 use ("-nostdlib");
535 end Builder;
536
537 package Binder is
538 case Mode is
539 when "debug" =>
540 for Switches ("Ada")
541 use ();
542 when "release" =>
543 for Switches ("Ada")
544 use ("-static");
545 end case;
546 end Binder;
547
548 end Cryostat;
-(0 . 0)(1 . 1)
553 Placeholder.
-(0 . 0)(1 . 1)
558 Placeholder.
-(0 . 0)(1 . 243)
563 ------------------------------------------------------------------------------
564 ------------------------------------------------------------------------------
565 -- This file is part of 'Cryostat', an Ada library for persistent storage. --
566 -- --
567 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
568 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
569 -- --
570 -- You do not have, nor can you ever acquire the right to use, copy or --
571 -- distribute this software ; Should you use this software for any purpose, --
572 -- or copy and distribute it to anyone or in any manner, you are breaking --
573 -- the laws of whatever soi-disant jurisdiction, and you promise to --
574 -- continue doing so for the indefinite future. In any case, please --
575 -- always : read and understand any software ; verify any PGP signatures --
576 -- that you use - for any purpose. --
577 ------------------------------------------------------------------------------
578 ------------------------------------------------------------------------------
579
580 with System; use System;
581
582
583 package body PMaps is
584
585 -- Open a backing file at Path, with given params, for use with Initialize
586 function OpenMapFile(Path : in String;
587 Writable : in Boolean := False;
588 Create : in Boolean := False) return FD is
589
590 -- Buffer for converting the civilized Path string to a C-style string :
591 CPath : String(1 .. Path'Length + 1) := (others => Character'Val(0));
592
593 -- Unix FD handle for the backing file, obtained by Open()
594 FileFD : FD;
595
596 -- Flags provided to Open() -- default 'read only'
597 COpenFlag : O_Flags := O_RDONLY;
598
599 begin
600
601 -- Convert civilized string to the barbaric type expected by Open() :
602 CPath(Path'Range) := Path;
603
604 -- Set the writability flag for Open() if Writable is enabled :
605 if Writable then
606 COpenFlag := O_RDWR;
607 end if;
608
609 -- If file does not exist, and Create is enabled, it will be created :
610 if Create then
611 COpenFlag := COpenFlag or O_CREAT;
612 end if;
613
614 -- Open the file :
615 FileFD := Open(CPath'Address, COpenFlag);
616
617 -- If Open() failed, eggog :
618 if FileFD = FD_EGGOG then
619 raise PMapFailedOpen with "PMap: Failed to Open backing file";
620 end if;
621
622 -- Return the FD of the backing file :
623 return FileFD;
624
625 end OpenMapFile;
626
627
628 -- Initialize a new map
629 procedure Initialize(Map : in out PMap) is
630
631 -- Prot flags to be given to MMap()
632 MProtFlag : MM_Prot := PROT_READ;
633
634 -- Result code returned by FTruncate()
635 CErr : Unix_Int;
636
637 begin
638
639 -- Check that we have not already Open'd:
640 if Map.Status /= Stop then
641 Map.Status := Eggog;
642 raise PMapFailedOpen with "PMap: already Opened backing file";
643 end if;
644
645 -- If Write is enabled, set the appropriate flag for MMap() :
646 if Map.MapWritable then
647 MProtFlag := PROT_READ or PROT_WRITE;
648 end if;
649
650 -- If creating, pad the backing file to the payload size :
651 if Map.MapCreate then
652 CErr := FTruncate(Map.FileFD, Map.MapLength);
653 if CErr /= 0 then
654 Map.Status := Eggog;
655 raise PMapFailedOpen with "PMap: Failed to FTruncate backing file";
656 end if;
657 end if;
658
659 -- Ask the OS to set up the map itself:
660 Map.Address := MMap(Length => Map.MapLength,
661 Off_T => Map.MapOffset,
662 Prot => MProtFlag,
663 Flags => MAP_SHARED,
664 Handle => Map.FileFD);
665
666 -- Test for failure of MMap() call :
667 if Map.Address = MAP_FAILED then
668 Map.Status := Eggog;
669 raise PMapFailedMMap with "PMap: MAP_FAILED";
670 end if;
671
672 if Map.Address = NullPtr then
673 Map.Status := Eggog;
674 raise PMapFailedAddr with "PMap: Map Address is Null";
675 end if;
676
677 -- If no failure detected, mark the map as usable :
678 Map.Status := Run;
679
680 end Initialize;
681
682
683 -- Test whether a map is operating
684 function IsReady(Map : in PMap) return Boolean is
685 begin
686
687 return Map.Status = Run;
688
689 end IsReady;
690
691
692 -- Retrieve the memory address where the map payload resides
693 function GetAddress(Map : in PMap) return MapAddress is
694 begin
695
696 -- Ensure that the map is active :
697 if not IsReady(Map) then
698 raise PMapNotRunning with "PMap: GetAddress on inactive Map";
699 end if;
700
701 -- Return the address :
702 return Map.Address;
703
704 end GetAddress;
705
706
707 -- Zeroize the map, if it is writable
708 procedure Zap(Map : in out PMap) is
709
710 -- Represent the map's payload as a byte array across full length :
711 RawArray : array(1 .. Map.MapLength) of Byte;
712 for RawArray'Address use Map.Address;
713
714 begin
715
716 -- If map is inactive, do nothing :
717 if not IsReady(Map) then
718 return;
719 end if;
720
721 -- If tried to zap a read-only map, eggog :
722 if Map.MapWritable = False then
723 raise PMapNotWritable with "PMap: Tried to Zap a Read-Only Map";
724 end if;
725
726 -- Zeroize the payload of the map :
727 RawArray := (others => 0);
728
729 end Zap;
730
731
732 -- Sync the map to disk
733 procedure Sync(Map : in out PMap) is
734
735 -- Result code returned by MSync() and Close()
736 CErr : Unix_Int := 0;
737
738 begin
739
740 -- If map is inactive, do nothing :
741 if not IsReady(Map) then
742 return;
743 end if;
744
745 -- If map is writable, sync it to disk :
746 if Map.MapWritable then
747 CErr := MSync(Map.Address, Map.MapLength, MS_SYNC);
748 end if;
749
750 -- If eggog during MSync() :
751 if CErr /= 0 then
752 Map.Status := Eggog;
753 CErr := Close(Map.FileFD);
754 raise PMapFailedSync with "PMap: Failed to Sync";
755 end if;
756
757 end Sync;
758
759
760 -- Close map and mark it unusable
761 procedure Stop(Map : in out PMap) is
762
763 -- Result code returned by MUnmap() and Close()
764 CErr : Unix_Int;
765
766 begin
767
768 -- If map is already inactive, do nothing :
769 if not IsReady(Map) then
770 return;
771 end if;
772
773 -- Sync all changes to disk, if map was writable :
774 Sync(Map);
775
776 -- Mark map as inactive :
777 Map.Status := Stop;
778
779 -- Unmap the map :
780 CErr := MUnmap(Map.Address, Map.MapLength);
781 if CErr /= 0 then
782 Map.Status := Eggog;
783 raise PMapFailedUnmap with "PMap: Failed to Unmap";
784 end if;
785
786 -- Lastly, close out the FD :
787 CErr := Close(Map.FileFD);
788 if CErr /= 0 then
789 Map.Status := Eggog;
790 raise PMapFailedClose with "PMap: Failed to Close backing file";
791 end if;
792
793 end Stop;
794
795
796 -- Sync and close a given map, if fell out of scope
797 procedure Finalize(Map : in out PMap) is
798 begin
799
800 -- Close the map :
801 Stop(Map);
802
803 end Finalize;
804
805 end PMaps;
-(0 . 0)(1 . 110)
810 ------------------------------------------------------------------------------
811 ------------------------------------------------------------------------------
812 -- This file is part of 'Cryostat', an Ada library for persistent storage. --
813 -- --
814 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
815 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
816 -- --
817 -- You do not have, nor can you ever acquire the right to use, copy or --
818 -- distribute this software ; Should you use this software for any purpose, --
819 -- or copy and distribute it to anyone or in any manner, you are breaking --
820 -- the laws of whatever soi-disant jurisdiction, and you promise to --
821 -- continue doing so for the indefinite future. In any case, please --
822 -- always : read and understand any software ; verify any PGP signatures --
823 -- that you use - for any purpose. --
824 ------------------------------------------------------------------------------
825 ------------------------------------------------------------------------------
826
827 with System;
828 with Ada.Finalization;
829 with Unix; use Unix;
830
831
832 package PMaps is
833
834 pragma Preelaborate;
835
836 -- Open file for map
837 function OpenMapFile(Path : in String;
838 Writable : in Boolean := False;
839 Create : in Boolean := False)
840 return FD
841 with Pre => not ((not Writable) and Create);
842
843 -- The address in memory where the map resides
844 subtype MapAddress is System.Address;
845
846 -- Internal representation of the map
847 type PMap(Handle : FD; -- Unix FD handle of the open file
848 Length : Word; -- The length (bytes) of the map
849 Offset : Word; -- Offset into the file (normally zero)
850 Create : Boolean; -- Whether to create the file if not exists
851 Writable : Boolean) -- Whether the map is writeable
852 is new Ada.Finalization.Limited_Controlled with private;
853
854 -- Test if map is usable
855 function IsReady(Map : in PMap) return Boolean;
856
857 -- Zero the entire map space
858 procedure Zap(Map : in out PMap);
859
860 -- Sync map to disk immediately
861 procedure Sync(Map : in out PMap);
862
863 -- Close map and mark it unusable
864 procedure Stop(Map : in out PMap);
865
866 -- Retrieve the address at which map resides
867 function GetAddress(Map : in PMap) return MapAddress;
868
869 -- Eggogs
870 PMapFailedOpen : exception; -- Could not open the given file
871 PMapFailedMMap : exception; -- Eggog when performed MMap()
872 PMapFailedAddr : exception; -- MMap() returned an unusable address
873 PMapFailedSync : exception; -- Sync failed
874 PMapFailedUnmap : exception; -- Unmap failed
875 PMapFailedClose : exception; -- Closing backing file failed
876 PMapNotRunning : exception; -- Tried to use an inactive map
877 PMapNotWritable : exception; -- Tried to zap a read-only map
878
879 private
880
881 -- Current state of the map
882 type State is (Stop, Run, Eggog);
883
884 type PMap(Handle : FD;
885 Length : Word;
886 Offset : Word;
887 Create : Boolean;
888 Writable : Boolean) is
889 new Ada.Finalization.Limited_Controlled with
890 record
891 -- Unix FD handle of the open file
892 FileFD : FD := Handle;
893
894 -- Whether to create the file if not exists
895 MapCreate : Boolean := Create;
896
897 -- Whether the map is writeable
898 MapWritable : Boolean := Writable;
899
900 -- The length (bytes) of the map
901 MapLength : Word := Length;
902
903 -- Offset into the file (normally zero)
904 MapOffset : Word := Offset;
905
906 -- The address in memory where the map resides
907 Address : MapAddress := NullPtr;
908
909 -- Current condition of this map
910 Status : State := Stop;
911 end record;
912
913 -- Initialization
914 overriding procedure Initialize(Map : in out PMap);
915
916 -- Automatic sync and close of the map when leaving scope
917 overriding procedure Finalize(Map : in out PMap);
918
919 end PMaps;
-(0 . 0)(1 . 83)
924 ------------------------------------------------------------------------------
925 ------------------------------------------------------------------------------
926 -- This file is part of 'Cryostat', an Ada library for persistent storage. --
927 -- --
928 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
929 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
930 -- --
931 -- You do not have, nor can you ever acquire the right to use, copy or --
932 -- distribute this software ; Should you use this software for any purpose, --
933 -- or copy and distribute it to anyone or in any manner, you are breaking --
934 -- the laws of whatever soi-disant jurisdiction, and you promise to --
935 -- continue doing so for the indefinite future. In any case, please --
936 -- always : read and understand any software ; verify any PGP signatures --
937 -- that you use - for any purpose. --
938 ------------------------------------------------------------------------------
939 ------------------------------------------------------------------------------
940
941 pragma Restrictions(Immediate_Reclamation);
942 pragma Restrictions(Max_Asynchronous_Select_Nesting => 0);
943 pragma Restrictions(Max_Protected_Entries => 0);
944 pragma Restrictions(Max_Select_Alternatives => 0);
945 pragma Restrictions(Max_Task_Entries => 0);
946 pragma Restrictions(Max_Tasks => 0);
947 pragma Restrictions(No_Abort_Statements);
948 pragma Restrictions(No_Access_Parameter_Allocators);
949 pragma Restrictions(No_Allocators);
950 pragma Restrictions(No_Asynchronous_Control);
951 pragma Restrictions(No_Calendar);
952 pragma Restrictions(No_Coextensions);
953 pragma Restrictions(No_Default_Stream_Attributes);
954 pragma Restrictions(No_Delay);
955 pragma Restrictions(No_Dispatch);
956 pragma Restrictions(No_Dispatching_Calls);
957 pragma Restrictions(No_Dynamic_Attachment);
958 pragma Restrictions(No_Dynamic_Priorities);
959 pragma Restrictions(No_Entry_Calls_In_Elaboration_Code);
960 pragma Restrictions(No_Entry_Queue);
961 pragma Restrictions(No_Enumeration_Maps);
962 pragma Restrictions(No_Exception_Propagation);
963 pragma Restrictions(No_Exception_Registration);
964 pragma Restrictions(No_Fixed_Io);
965 pragma Restrictions(No_Floating_Point);
966 pragma Restrictions(No_Implementation_Aspect_Specifications);
967 pragma Restrictions(No_Implementation_Units);
968 pragma Restrictions(No_Implicit_Dynamic_Code);
969 pragma Restrictions(No_Implicit_Heap_Allocations);
970 pragma Restrictions(No_Implicit_Protected_Object_Allocations);
971 pragma Restrictions(No_Implicit_Task_Allocations);
972 pragma Restrictions(No_Initialize_Scalars);
973 pragma Restrictions(No_Local_Protected_Objects);
974 pragma Restrictions(No_Local_Timing_Events);
975 pragma Restrictions(No_Protected_Type_Allocators);
976 pragma Restrictions(No_Protected_Types);
977 pragma Restrictions(No_Relative_Delay);
978 pragma Restrictions(No_Requeue_Statements);
979 pragma Restrictions(No_Secondary_Stack);
980 pragma Restrictions(No_Select_Statements);
981 pragma Restrictions(No_Specific_Termination_Handlers);
982 pragma Restrictions(No_Standard_Allocators_After_Elaboration);
983 pragma Restrictions(No_Stream_Optimizations);
984 pragma Restrictions(No_Streams);
985 pragma Restrictions(No_Task_Allocators);
986 pragma Restrictions(No_Task_At_Interrupt_Priority);
987 pragma Restrictions(No_Task_Attributes_Package);
988 pragma Restrictions(No_Task_Hierarchy);
989 pragma Restrictions(No_Tasking);
990 pragma Restrictions(No_Task_Termination);
991 pragma Restrictions(No_Terminate_Alternatives);
992 pragma Restrictions(No_Unchecked_Access);
993 pragma Restrictions(No_Unchecked_Conversion);
994 pragma Restrictions(No_Unchecked_Deallocation);
995 pragma Restrictions(No_Wide_Characters);
996 pragma Restrictions(Pure_Barriers);
997 pragma Restrictions(Simple_Barriers);
998 pragma Restrictions(Static_Priorities);
999 pragma Restrictions(Static_Storage_Size);
1000 pragma Validity_Checks(ALL_CHECKS);
1001
1002 ----- Deliberately omitted (we use these) :
1003
1004 -- pragma Restrictions(No_Finalization);
1005 -- pragma Restrictions(No_Nested_Finalization);
1006 -- pragma Restrictions(No_Multiple_Elaboration);
-(0 . 0)(1 . 111)
1011 ------------------------------------------------------------------------------
1012 ------------------------------------------------------------------------------
1013 -- This file is part of 'Cryostat', an Ada library for persistent storage. --
1014 -- --
1015 -- (C) 2020 Stanislav Datskovskiy ( www.loper-os.org ) --
1016 -- http://wot.deedbot.org/17215D118B7239507FAFED98B98228A001ABFFC7.html --
1017 -- --
1018 -- You do not have, nor can you ever acquire the right to use, copy or --
1019 -- distribute this software ; Should you use this software for any purpose, --
1020 -- or copy and distribute it to anyone or in any manner, you are breaking --
1021 -- the laws of whatever soi-disant jurisdiction, and you promise to --
1022 -- continue doing so for the indefinite future. In any case, please --
1023 -- always : read and understand any software ; verify any PGP signatures --
1024 -- that you use - for any purpose. --
1025 ------------------------------------------------------------------------------
1026 ------------------------------------------------------------------------------
1027
1028 ------------------------------------------------------------------------------
1029 -- WARNING : MIPS32/64 currently unsupported! --
1030 -- See also: http://logs.nosuchlabs.com/log/trilema/2018-10-24#1865524 --
1031 ------------------------------------------------------------------------------
1032
1033 with Interfaces; use Interfaces;
1034 with Interfaces.C;
1035 with System; use System;
1036
1037
1038 package Unix is
1039
1040 pragma Preelaborate;
1041
1042 -- Machine Word
1043 type Word is mod 2**Standard'Address_Size;
1044
1045 -- Byte
1046 type Byte is mod 2**8;
1047
1048 -- Unit int
1049 type Unix_Int is mod 2**Interfaces.C.int'Size;
1050
1051 -- File descriptors
1052 type FD is new Unix_Int;
1053
1054 type MM_Prot is new Unix_Int;
1055 PROT_READ : constant MM_Prot := 1;
1056 PROT_WRITE : constant MM_Prot := 2;
1057
1058 type MM_Flags is new Unix_Int;
1059 MAP_NONE : constant MM_Flags := 16#00#;
1060 MAP_FIXED : constant MM_Flags := 16#10#;
1061 MAP_SHARED : constant MM_Flags := 16#01#;
1062 MAP_PRIVATE : constant MM_Flags := 16#02#;
1063 -- TODO: MAP_HUGETLB
1064
1065 -- Null Pointer
1066 NullPtr : constant Address := System'To_Address(0);
1067
1068 function MMap
1069 (Start : Address := NullPtr;
1070 Length : Word;
1071 Prot : MM_Prot;
1072 Flags : MM_Flags;
1073 Handle : FD;
1074 Off_T : Word := 0)
1075 return Address;
1076 pragma Import(C, MMap, "mmap");
1077
1078 -- Eggog code '-1' (posix uses instead of null here)
1079 MAP_FAILED : constant Address := System'To_Address(Word'Last);
1080
1081 function MUnmap
1082 (Start : Address;
1083 Length : Word)
1084 return Unix_Int;
1085 pragma Import(C, MUnmap, "munmap");
1086
1087 type O_Flags is new Unix_Int;
1088 O_RDONLY : constant O_Flags := 8#00#;
1089 O_WRONLY : constant O_Flags := 8#01#;
1090 O_RDWR : constant O_Flags := 8#02#;
1091 O_CREAT : constant O_Flags := 8#0100#;
1092
1093 type M_Flags is new Unix_Int;
1094 MS_ASYNC : constant M_Flags := 1;
1095 MS_INVALIDATE : constant M_Flags := 2;
1096 MS_SYNC : constant M_Flags := 4;
1097
1098 function MSync
1099 (Addr : Address;
1100 Length : Word;
1101 Flags : M_Flags)
1102 return Unix_Int;
1103 pragma Import(C, MSync, "msync");
1104
1105 function Open
1106 (Name : System.Address;
1107 Flags : O_Flags;
1108 Mode : Unix_Int := 8#666#) -- TODO
1109 return FD;
1110 pragma Import(C, Open, "open");
1111
1112 -- '-1'
1113 FD_EGGOG : constant FD := FD'Last;
1114
1115 function Close(Handle : FD) return Unix_Int;
1116 pragma Import(C, Close, "close");
1117
1118 function FTruncate(Handle : FD; Length : Word) return Unix_Int;
1119 pragma Import(C, FTruncate, "ftruncate");
1120
1121 end Unix;