mirror of
https://github.com/AdaCore/florist.git
synced 2026-02-12 13:10:32 -08:00
dacffa1db0
Style cleanup missing from recent commits. no-precommit-check (to avoid complains about copyright headers) TN: V209-051 Change-Id: Id614483a4a69f1b430860cb6101fdad249bcb3ef
169 lines
6.4 KiB
Ada
169 lines
6.4 KiB
Ada
------------------------------------------------------------------------------
|
|
-- --
|
|
-- FLORIST (FSU Implementation of POSIX.5) COMPONENTS --
|
|
-- --
|
|
-- P O S I X . M E M O R Y _ M A P P I N G --
|
|
-- --
|
|
-- B o d y --
|
|
-- --
|
|
-- --
|
|
-- Copyright (C) 1996-1997 Florida State University --
|
|
-- Copyright (C) 1998-2014, AdaCore --
|
|
-- --
|
|
-- This file is a component of FLORIST, an implementation of an Ada API --
|
|
-- for the POSIX OS services, for use with the GNAT Ada compiler and --
|
|
-- the FSU Gnu Ada Runtime Library (GNARL). The interface is intended --
|
|
-- to be close to that specified in IEEE STD 1003.5: 1990 and IEEE STD --
|
|
-- 1003.5b: 1996. --
|
|
-- --
|
|
-- FLORIST is free software; you can redistribute it and/or modify it --
|
|
-- under terms of the GNU General Public License as published by the --
|
|
-- Free Software Foundation; either version 2, or (at your option) any --
|
|
-- later version. FLORIST is distributed in the hope that it will be --
|
|
-- useful, but WITHOUT ANY WARRANTY; without even the implied warranty --
|
|
-- of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
|
|
-- General Public License for more details. You should have received a --
|
|
-- copy of the GNU General Public License distributed with GNARL; see --
|
|
-- file COPYING. If not, write to the Free Software Foundation, 59 --
|
|
-- Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
|
|
-- --
|
|
-- As a special exception, if other files instantiate generics from this --
|
|
-- unit, or you link this unit with other files to produce an executable, --
|
|
-- this unit does not by itself cause the resulting executable to be --
|
|
-- covered by the GNU General Public License. This exception does not --
|
|
-- however invalidate any other reasons why the executable file might be --
|
|
-- covered by the GNU Public License. --
|
|
-- --
|
|
------------------------------------------------------------------------------
|
|
|
|
with Ada.Unchecked_Conversion,
|
|
POSIX.Implementation;
|
|
|
|
package body POSIX.Memory_Mapping is
|
|
|
|
use POSIX.Implementation;
|
|
use System;
|
|
|
|
function To_Address is
|
|
new Ada.Unchecked_Conversion (ptr_as_int, System.Address);
|
|
|
|
Zero_Address : constant System.Address := To_Address (0);
|
|
Failure : constant System.Address := To_Address (MAP_FAILED);
|
|
|
|
------------------
|
|
-- Map_Memory --
|
|
------------------
|
|
|
|
function mmap
|
|
(addr : System.Address;
|
|
len : size_t;
|
|
prot : int;
|
|
flags : int;
|
|
fildes : int;
|
|
off : off_t) return System.Address;
|
|
pragma Import (C, mmap, mmap_LINKNAME);
|
|
|
|
function Map_Memory
|
|
(First : System.Address;
|
|
Length : System.Storage_Elements.Storage_Offset;
|
|
Protection : Protection_Options;
|
|
Mapping : Mapping_Options;
|
|
Location : Location_Options;
|
|
File : POSIX.IO.File_Descriptor;
|
|
Offset : POSIX.IO_Count)
|
|
return System.Address is
|
|
Result : System.Address;
|
|
begin
|
|
Result := mmap
|
|
(First,
|
|
size_t (Length),
|
|
int (Option_Set (Protection).Option),
|
|
int (Option_Set (Mapping).Option or Option_Set (Location).Option
|
|
or MAP_FILE),
|
|
int (File),
|
|
off_t (Offset));
|
|
if Result = Failure then
|
|
Raise_POSIX_Error;
|
|
end if;
|
|
return Result;
|
|
end Map_Memory;
|
|
|
|
------------------
|
|
-- Map_Memory --
|
|
------------------
|
|
|
|
function Map_Memory
|
|
(Length : System.Storage_Elements.Storage_Offset;
|
|
Protection : Protection_Options;
|
|
Mapping : Mapping_Options;
|
|
File : POSIX.IO.File_Descriptor;
|
|
Offset : POSIX.IO_Count)
|
|
return System.Address is
|
|
Result : System.Address;
|
|
begin
|
|
Result := mmap
|
|
(Zero_Address,
|
|
size_t (Length),
|
|
int (Option_Set (Protection).Option),
|
|
int (Option_Set (Mapping).Option or MAP_FILE),
|
|
int (File),
|
|
off_t (Offset));
|
|
if Result = Failure then
|
|
Raise_POSIX_Error;
|
|
end if;
|
|
return Result;
|
|
end Map_Memory;
|
|
|
|
--------------------
|
|
-- Unmap_Memory --
|
|
--------------------
|
|
|
|
procedure Unmap_Memory
|
|
(First : System.Address;
|
|
Length : System.Storage_Elements.Storage_Offset) is
|
|
function munmap
|
|
(addr : System.Address;
|
|
len : size_t) return int;
|
|
pragma Import (C, munmap, munmap_LINKNAME);
|
|
begin
|
|
Check (munmap (First, size_t (Length)));
|
|
end Unmap_Memory;
|
|
|
|
-------------------------
|
|
-- Change_Protection --
|
|
-------------------------
|
|
|
|
procedure Change_Protection
|
|
(First : System.Address;
|
|
Length : System.Storage_Elements.Storage_Offset;
|
|
Protection : Protection_Options) is
|
|
function mprotect
|
|
(addr : System.Address;
|
|
len : size_t;
|
|
prot : int) return int;
|
|
pragma Import (C, mprotect, mprotect_LINKNAME);
|
|
begin
|
|
Check (mprotect (First, size_t (Length),
|
|
int (Option_Set (Protection).Option)));
|
|
end Change_Protection;
|
|
|
|
--------------------------
|
|
-- Synchronize_Memory --
|
|
--------------------------
|
|
|
|
procedure Synchronize_Memory
|
|
(First : System.Address;
|
|
Length : System.Storage_Elements.Storage_Offset;
|
|
Options : Synchronize_Memory_Options := Wait_For_Completion) is
|
|
function msync
|
|
(address : System.Address;
|
|
len : size_t;
|
|
flags : int) return int;
|
|
pragma Import (C, msync, msync_LINKNAME);
|
|
begin
|
|
Check (msync
|
|
(First, size_t (Length), int (Option_Set (Options).Option)));
|
|
end Synchronize_Memory;
|
|
|
|
end POSIX.Memory_Mapping;
|