Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/cais/cais.src

Text File | 1988-05-03 | 1.3 MB | 37,984 lines

--::::::::::::::
--CAIS.pro
--::::::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : CAIS
-- Version      : 860307
-- Author       : Mitre Corp.
--              : Rebecca Bowerman    Helen Gill
--              : Chuck Howell        Robbie Hutchison
--              : Mike McClimens
-- DDN Address  : cig-info at mitre
-- Date created : 07 MAR 86
-- Release date : 07 MAR 86
-- Last update  : 07 MAR 86
-- Machine/System Compiled/Run on : Vax 8600
--                                  UNIX
--                                  Verdix Ada Development Sys
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  Tool Interfaces, Portability, Stoneman,
--                 Operating System Calls, Host-Dependencies,
--                 MIL-STD-CAIS, APSE, Programming Support Environment
----------------:
--
-- Abstract     :
--         This CAIS package provides a robust subset of the inter-
--    faces defined in the proposed Military Standard Common Apse
--    Interface Set(CAIS).  The goal of MIL-STD-CAIS is to promote
--    tool portability by providing a standardized set of calls for
--    operating system services.  It is also hoped that definition
--    of a generalized node model will increase the interoperability
--    of tool sets.
--
--         This subset includes:
--             5.1.1,2,3,5 -- Node_Definitions, Node_Management,
--                            Attributes, and Structural_Nodes
--             5.3.1,1-4,10-- Io_Definitions ,Direct_Io, Sequential_Io,
--                            Text_Io, and File_Import_Export (also a
--                            few procedures from Scroll_Terminal)
--             5.4.1-20,21 -- List_Utilities, Identifier_Items, and
--                            String_Items
--    The interfaces not included are Access_Control, Process_Control,
--    Io_Control, the Io device packages, Float_Item, and Integer_Item.
--
--         It is intended that this CAIS subset be used to investigate
--    the extent to which CAIS supports the needs of software
--    development tools.  Only by rehosting tools and their data to
--    CAIS can the viability of CAIS be determined.
----------------:
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE      VERSION AUTHOR        HISTORY
-- 03/07/85  860307  Mitre Corp    Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
--
-- Restrictions on use or distribution:  Although there are
--      no current plans to provide maintenance for this CAIS,
--      further modifications are planned. We would appreciate
--      your reporting problems and experiences to:
--
--                cig-info at mitre    (net address)
--
--      or call at:
--
--                (703)  883-7858
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

--::::::::::::::
--cais.pro
--::::::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : CAIS
-- Version      : 860307
-- Author       : Mitre Corp.
--              : Rebecca Bowerman    Helen Gill
--              : Chuck Howell        Robbie Hutchison
--              : Mike McClimens
-- DDN Address  : cig-info at mitre
-- Date created : 07 MAR 86
-- Release date : 07 MAR 86
-- Last update  : 07 MAR 86
-- Machine/System Compiled/Run on : Vax 8600
--                                  UNIX
--                                  Verdix Ada Development Sys
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  Tool Interfaces, Portability, Stoneman,
--                 Operating System Calls, Host-Dependencies,
--                 MIL-STD-CAIS, APSE, Programming Support Environment
----------------:
--
-- Abstract     :
--         This CAIS package provides a robust subset of the inter-
--    faces defined in the proposed Military Standard Common Apse
--    Interface Set(CAIS).  The goal of MIL-STD-CAIS is to promote
--    tool portability by providing a standardized set of calls for
--    operating system services.  It is also hoped that definition
--    of a generalized node model will increase the interoperability
--    of tool sets.
--
--         This subset includes:
--             5.1.1,2,3,5 -- Node_Definitions, Node_Management,
--                            Attributes, and Structural_Nodes
--             5.3.1,1-4,10-- Io_Definitions ,Direct_Io, Sequential_Io,
--                            Text_Io, and File_Import_Export (also a
--                            few procedures from Scroll_Terminal)
--             5.4.1-20,21 -- List_Utilities, Identifier_Items, and
--                            String_Items
--    The interfaces not included are Access_Control, Process_Control,
--    Io_Control, the Io device packages, Float_Item, and Integer_Item.
--
--         It is intended that this CAIS subset be used to investigate
--    the extent to which CAIS supports the needs of software
--    development tools.  Only by rehosting tools and their data to
--    CAIS can the viability of CAIS be determined.
----------------:
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE      VERSION AUTHOR        HISTORY
-- 03/07/85  860307  Mitre Corp    Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
--
-- Restrictions on use or distribution:  Although there are
--      no current plans to provide maintenance for this CAIS,
--      further modifications are planned. We would appreciate
--      your reporting problems and experiences to:
--
--                cig-info at mitre    (net address)
--
--      or call at:
--
--                (703)  883-7858
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

--::::::::::::::
--README
--::::::::::::::
1. Introduction
    This is a brief (very brief!) overview of the MITRE CAIS
    prototype.  The Simtel20 prologue associated with the source code
    and the file and module prologues associated with the specific
    code portions should be consulted for additional information on
    portions of the source code.

2. Overview Of The Prototype
    The prototype is distributed in 67 Ada files and 8 "C" files.
    The Ada file names (in a compilation order) are:

        trace_spec.a
        cset.a
        generic_stack.a
        str_pack-spec.a
        generic_list.a
        trace_body.a
        str_pack-body.a
        cais_spec.a
        test_internals.a
        cais_body.a
        node_internals_body.a
        get_identifier.a
        read_shadow_file.a
        get_parsed_pn.a
        write_shadow_file.a
        create_node.a
        get_next_token.a
        direct_io_definitions_body.a
        sequential_io_definitions_body.a
        node_management_body.a
        copy_tree.a
        copy_node.a
        node_more.a
        delete_node.a
        delete_tree.a
        rename.a
        node_get_next.a
        node_iterate.a
        access_control_body.a
        process_control_body.a
        invoke_process.a
        cais_host_dependent_body.a
        get_userid.a
        get_unique_filename.a
        get_user_prefix.a
        add_user.a
        file_import_export_body.a
        cais_utilities_body.a
        attributes_body.a
        structural_nodes_body.a
        iterator_support_body.a
        magnetic_tape_body.a
        cais_sequential_io_body.a
        cais_direct_io_body.a
        cais_io_definitions_body.a
        io_control_body.a
        page_terminal_body.a
        form_terminal_body.a
        delete_user.a
        node_representation_body.a
        list_utilities_body.a
        parse_list.a
        v_string_body.a
        dump.a
        parse_token.a
        identifier_items.a
        scroll_terminal_body.a
        string_items.a
        cais_text_io_body.a
        text_file_create.a
        text_file_delete.a
        text_file_open.a
        text_file_reset.a
        cais_generics.a
        predef_relationships.a
        set_for_append.a
        text_file_close.a

    The "C" files are:
        cbreak.c
        cfile_exists.c
        cget_userid.c
        charget.c
        create_uniq.c
        get_user.c
        setecho.c
        simple_fork.c

3. Installing The Prototype On Unix

    There are essentially three steps to installing the CAIS
    Prototype on a UNIX system:
    a) tailoring the file names in Cais_Host_Dependent to
      reflect your system;
    b) compiling the Ada code (e.g. using VADS,
      a.make -f *.a in a directory with all of the prototype code);
    c) building an archive file for the "C" code
        (the following example assumes that the only .o files in the
         directory are from the cc of the CAIS "C" code;
         c-code.A should be replaced by your chosen archive name)
        cc -c *.c;
        ar q c-code.A *.o;
        ranlib c-code.A;
        ar t c-code.A;

    When linking your Ada program with CAIS code, remember to include
    the archive file (e.g. on VADS,
    a.ld <your_unit> -lm <archive file>; )

    Please see section 5 for information on the selection of
    file names for Cais_Host_Dependent.

4. Rehosting On Another System

    A rehost of the MITRE CAIS prototype to VMS is being performed
    as one of the aspects of the FY86 IR&D on the CAIS at MITRE.
    The prototype code has been structured to faciliate rehosting.
    All of the dependencies on the underlying OS are isolated in the
    package Cais_Host_Dependent.  A rehost requires that the bodies
    of the routines in this package be implemented for the new host
    OS.  For example, in the current prototype, there are several
    uses of pragma Interface (C,...) in Cais_Host_Dependent.
    Presumably host-dependent routines similar to the UNIX-specific
    C code routines used here will be required for the new host.

5. System Administration For the Prototype
    A. Adding Users
    The parameterless procedure Add_User is in package Cais.
    This procedure will prompt the user for a new userid and
    user prefix.  The userid is the key to the 'User relation
    that will identify the new user; in effect Add_User is
    adding a new 'User relationship to the System_Node.

    The userid is required to be a valid Ada identifier since it
    will be used as a relationship key.  Not all host OS userids
    are valid Ada identifiers, however.  The Cais prototype code
    uses a the routine Cais_Host_Dependent.Get_Userid  to
    determine this key.  In the UNIX version of the prototype,
    a Shell environment variable is used to set this name.
    Typically a CAIS prototype user has in his or her .login
    file something like the following line:
        setenv CAIS_USERID howell
    The name of the environment variable is CAIS_USERID.

    The user prefix is the path prefix (including the final
    directory delimiter, e.g. "/usr2/howell/") that is prepended
    to certain prototype-created files for each user.

    B.  Host files
    The host dependent file structure for the prototype involves
    one directory, one unique file, and two files for each user
    of the CAIS.  The host-dependent names for all of these
    files is established in the package Cais_Host_Dependent.

    The Cais_Host_Directory is where a number of files will be
    created (a shadow file is the file created to capture information
    about a node e.g. attributes and relations).  It is necessary
    that all CAIS users for your system have read, search, and
    write priveledges for this directory.

    The Cais_System_Node is the host file that captures much of the
    information of the structure of the prototype.   It is
    written to by the procedure Add_User, and several prototype
    routines read it.  It is necessary that all CAIS users have
    read priveledges for this host file.

    Each user will also get two files created in the directory
    specified as the "user prefix" during Add_User.  The Top_Node
    is the file that captures information about the structural
    node that is the top node for each user.  Top_User_Process
    is the file where information about the process node
    representing the user's initial job is captured.

--::::::::::::::
--access_control_body.a
--::::::::::::::
with Trace;
separate(Cais)
package body Access_Control is
    use Node_Definitions;


    procedure Set_Access_Control(Node      : Node_Type;
                                 Role_Node : Node_Type;
                                 Grant     : Grant_Value) is
    begin
        Trace.Assert_Fatal(False, "Set_Access_Control is NOT implemented");
    end Set_Access_Control;

    procedure Set_Access_Control(Name      : Name_String;
                                 Role_Name : Name_String;
                                 Grant     : Grant_Value) is
    begin
        Trace.Assert_Fatal(False, "Set_Access_Control is NOT implemented");
    end Set_Access_Control;

    function Is_Granted(Object_Node  : Node_Type;
                        Access_Right : Name_String) return Boolean is
    begin
        Trace.Assert_Fatal(False, "Is_Granted is NOT implemented");
        return False;
    end Is_Granted;

    function Is_Granted(Object_Name  : Name_String;
                        Access_Right : Name_String) return Boolean is
    begin
        Trace.Assert_Fatal(False, "Is_Granted is NOT implemented");
        return False;
    end Is_Granted;

    procedure Adopt(Role_Node : Node_Type;
                    Role_Key  : Relationship_Key := Latest_Key) is
    begin
        Trace.Assert_Fatal(False, "Adopt is NOT implemented");
    end Adopt;

    procedure Unadopt(Role_Key : Relationship_Key) is
    begin
        Trace.Assert_Fatal(False, "Unadopt is NOT implemented");
    end Unadopt;

end Access_Control;
--::::::::::::::
--add_user.a
--::::::::::::::

----------------------------------------------------------------------
--                        A D D _ U S E R
--
--
--               CAIS tool to add a user to the CAIS
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--                   Thu Feb 20 00:27:43 EST 1986
--
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
    -- Add_User will add the following information to the
    -- SYSTEM_NODE (if the user already is in the SYSTEM_NODE,
    -- Add_User will verify that the old values should be replaced):
        -- the primary relation USER pointing to the user's TOP_NODE
        -- the user prefix for the user (an attribute of USER)
    -- Add_User will then create a .TOP_NODE in the user prefix directory.
    -- Add_User will also create a current process node shadow file.

    -- .TOP_NODE contains:
        -- the JOB primary relation, pointing to the Current_Process node
        -- the PARENT secondary relationship, pointing to SYSTEM_NODE
    -- the Current_Process shadow file contains:
        -- the CURRENT_JOB secondary relationship, => Current_Proc
        -- the CURRENT_NODE secondary rel, => .TOP_NODE
        -- the CURRENT_USER secondary rel, => .TOP_NODE
        -- the PARENT secondary relationship, pointing to SYSTEM_NODE
        -- the USER secondary rel, => .TOP_NODE

with Text_Io;

separate(Cais)
procedure Add_User is

    use Standard.Text_Io;
    use Node_Definitions;
    use Node_Representation;
    use Cais_Host_Dependent;
    use List_Utilities;
    use Pragmatics;
    use Node_Internals;
    use Cais_Internals_Exceptions;
    use Cais_Utilities; -- frequently used routines
    use List_Utilities.String_Items;


    Attributes         : List_Type;
    Simple_List        : List_Type;
    All_Users          : List_Type;
    User_Count         : List_Utilities.Count;
    User_Name          : Token_Type;
    User_Exists        : Boolean := True;
    Node               : Node_Type;
    Primary            : Boolean;
    Userid             : String(1 .. Max_Userid_Length);
    User_Prefix        : String(1 .. Max_User_Prefix_Length);
    Dummy_Shadow_File  : String(1 .. Max_Shadow_File_Length);
    Userid_Length      : Natural;
    User_Prefix_Length : Natural;

    Valid_Response     : Boolean := False;
    type Response is (Yes, No);
    Procede    : Response;
    List_Users : Response;

    package Yesno is
        new Enumeration_Io(Response);
    use Yesno;

begin
    Get_Node : begin
        Set_Shadow_File_Name(Node, Cais_System_Node);
        Read_Shadow_File(Node);

        while not Valid_Response loop
            Put("List Current CAIS Users? (yes or no):");
            Get_Answer1 : begin
                Get(List_Users);
                if List_Users = Yes then

                    Get_A_Relation(Node, "User", All_Users);
                    User_Count := Length(All_Users);
                    Put_Line("Number Of Users: " & Integer'Image(Integer(
                        User_Count)));
                    New_Line;
                    for I in 1 .. User_Count loop
                        Item_Name(All_Users, I, User_Name);
                        Put(Identifier_Items.To_Text(User_Name));
                        Put(" " & Cais_Host_Dependent.Get_User_Prefix(
                            Identifier_Items.To_Text(User_Name)));
                        Put_Line(Cais_Host_Dependent.Top_User_Process);
                    end loop;

                end if;
                Valid_Response := True;
            exception
                when Data_Error =>
                    Put_Line(Ascii.Bel & "PLEASE ENTER EITHER YES OR NO ONLY.")
                        ;
            end Get_Answer1;
        end loop;
    Skip_Line(Standard_Input);

    exception
        when No_Such_Shadow_File | No_Such_Relationship =>
            -- USER relation with the specified key was not found
            User_Exists := False;
    end Get_Node;

    Get_User_Info: begin
        Valid_Response := False;

        Put("Please Enter the New Userid: ");
        Get_Line(Userid, Userid_Length);
        Put("Please Enter the New User_Prefix: ");
        Get_Line(User_Prefix, User_Prefix_Length);

    if User_Exists then
        Get_A_Relationship(Node, "USER", Userid(1 .. Userid_Length),
        Dummy_Shadow_File, Attributes, Primary);
    end if;
    exception
        when No_Such_Shadow_File | No_Such_Relationship =>
            -- USER relation with the specified key was not found
            User_Exists := False;
    end Get_User_Info;

    if User_Exists then
        while not Valid_Response loop
            Put("User already exists. Replace? (yes or no):");
            Get_Answer2 : begin
                Get(Procede);
                if Procede = No then
                    return;
                end if;
                Valid_Response := True;
            exception
                when Data_Error =>
                    Put_Line(Ascii.Bel & "PLEASE ENTER EITHER YES OR NO ONLY.")
                        ;
            Skip_Line(Standard_Input);
            end Get_Answer2;
        end loop;

    end if; -- User_Exists

    Copy(Attributes, Empty_List);
    String_To_Simple_List(User_Prefix(1 .. User_Prefix_Length), Simple_List);
    Insert(Attributes, List_Item => Simple_List, Named => "User_Prefix",
        Position => 0);
    String_To_Simple_List("STRUCTURAL", Simple_List);
    Insert(Attributes, List_Item => Simple_List, Named => "Kind", Position => 0)
        ;

    Set_A_Relationship(Node, "USER", Userid(1 .. Userid_Length), Attributes,
        Primary => True, Shadow_File => User_Prefix(1 .. User_Prefix_Length) &
        Top_User_Node);
    Set_Kind(Node, Structural);
    Write_Shadow_File(Node);

    -- Now we add CAIS shadow files in the user's "CAIS" directory.
    -- First, create the CURRENT_PROCESS node (this is the stopgap
    -- approach for now; a much different approach may be needed when
    -- we support process spawning...)
    Set_Shadow_File_Name(Node, User_Prefix(1 .. User_Prefix_Length) &
        Top_User_Process);
    Set_Kind(Node, Process);

    -- "reset" the node relations, then add the appropriate ones
    Set_Node_Relations(Node, Empty_List);
    Copy(Attributes, Empty_List);
    String_To_Simple_List("PROCESS", Simple_List);
    Insert(Attributes, List_Item => Simple_List, Named => "Kind", Position => 0)
        ;
    Set_A_Relationship(Node => Node, Rel_Name => "CURRENT_JOB", Rel_Key => "",
        Rel_Attributes => Attributes, Primary => False, Shadow_File =>
        User_Prefix(1 .. User_Prefix_Length) & Top_User_Process);
        -- NB: The Rel_Key above should be #, and will be changed to
        -- that when this feature is supported. CCH

    String_To_Simple_List("STRUCTURAL", Simple_List);
    Replace(Attributes, List_Item => Simple_List, Named => "Kind");
    Set_A_Relationship(Node => Node, Rel_Name => "CURRENT_NODE", Rel_Key => "",
        Rel_Attributes => Attributes, Primary => False, Shadow_File =>
        User_Prefix(1 .. User_Prefix_Length) & Top_User_Node);

    Set_A_Relationship(Node => Node, Rel_Name => "CURRENT_USER", Rel_Key => "",
        Rel_Attributes => Attributes, Primary => False, Shadow_File =>
        User_Prefix(1 .. User_Prefix_Length) & Top_User_Node);

    Set_A_Relationship(Node => Node, Rel_Name => "USER", Rel_Key => Userid(1 ..
        Userid_Length), Rel_Attributes => Attributes, Primary => False,
        Shadow_File => User_Prefix(1 .. User_Prefix_Length) & Top_User_Node);

    -- Attributes of the Parent relation are the Kind (standard for all
    -- relations), and the primary relationship and key from the parent
    -- node that designates this new node
    Copy(Attributes, Empty_List);
    Cais_Utilities.String_To_Simple_List("STRUCTURAL", Simple_List);
    Insert(Attributes, Simple_List, "Kind", 0);
    Cais_Utilities.String_To_Simple_List("JOB", Simple_List);
    Insert(Attributes, Simple_List, "Primary_Relation", 0);
    Cais_Utilities.String_To_Simple_List(Null_Rel_Key, Simple_List);
    Insert(Attributes, Simple_List, "Primary_Key", 0);

    Set_A_Relationship(Node => Node, Rel_Name => "PARENT", Rel_Key => "",
        Rel_Attributes => Attributes, Primary => False, Shadow_File =>
        User_Prefix(1 .. User_Prefix_Length) & Top_User_Node);

    Set_Node_Attributes(Node, Empty_List);
    Write_Shadow_File(Node);

    -- Now to add the shadow file for the TOP_USER_NODE
    Set_Shadow_File_Name(Node, User_Prefix(1 .. User_Prefix_Length) &
        Top_User_Node);
    Set_Kind(Node, Structural);
    Set_Node_Relations(Node, Empty_List);

    String_To_Simple_List("PROCESS", Simple_List);
    Replace(Attributes, List_Item => Simple_List, Named => "Kind");
    Set_A_Relationship(Node => Node, Rel_Name => "JOB", Rel_Key => "",
        Rel_Attributes => Attributes, Primary => True, Shadow_File =>
        User_Prefix(1 .. User_Prefix_Length) & Top_User_Process);


    -- Attributes of the Parent relation are the Kind (standard for all
    -- relations), and the primary relationship and key from the parent
    -- node that designates this new node
    Copy(Attributes, Empty_List);
    Cais_Utilities.String_To_Simple_List("STRUCTURAL", Simple_List);
    Insert(Attributes, Simple_List, "Kind", 0);
    Cais_Utilities.String_To_Simple_List("USER", Simple_List);
    Insert(Attributes, Simple_List, "Primary_Relation", 0);
    Cais_Utilities.String_To_Simple_List(Userid(1 .. Userid_Length), Simple_List
        );
    Insert(Attributes, Simple_List, "Primary_Key", 0);
    Set_A_Relationship(Node => Node, Rel_Name => "PARENT", Rel_Key => "",
        Rel_Attributes => Attributes, Primary => False, Shadow_File =>
        Cais_System_Node);
    Write_Shadow_File(Node);

    -- Finally, update the user relation of all of the other
    -- users' top_process shadow files

    Copy(Attributes, Empty_List);
    String_To_Simple_List("STRUCTURAL", Simple_List);
    Insert(Attributes, List_Item => Simple_List, Named => "Kind", Position => 0)
        ;
    Set_Shadow_File_Name(Node, Cais_System_Node);
    Read_Shadow_File(Node);
    Get_A_Relation(Node, "User", All_Users);
    User_Count := Length(All_Users);
    for I in 1 .. User_Count loop
        Item_Name(All_Users, I, User_Name);
        Set_Shadow_File_Name(Node, Cais_Host_Dependent.Get_User_Prefix(
            Identifier_Items.To_Text(User_Name)) & Cais_Host_Dependent.
            Top_User_Process);
        Read_Shadow_File(Node);

        Set_A_Relationship(Node => Node, Rel_Name => "USER", Rel_Key => Userid(1
            .. Userid_Length), Rel_Attributes => Attributes, Primary => False,
            Shadow_File => User_Prefix(1 .. User_Prefix_Length) & Top_User_Node)
            ;
        Write_Shadow_File(Node);
    end loop;
end Add_User;
--::::::::::::::
--attributes_body.a
--::::::::::::::

----------------------------------------------------------------------
--                         ATTRIBUTES
--                       (Package Body)
--
--
--      Package to support the definition and manipulation of
--             attributes for nodes and relationships.
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Fri Oct 11 08:41:09 EDT 1985
--
--                 (Unclassified and uncopyrighted)
----------------------------------------------------------------------
----------------------------------------------------------------------
--
--  Purpose:
--  --------
--    This  package  supports  the  definition  and  manipulation   of
--    attributes for nodes and relationships in the CAIS.  The name of
--    an attribute follows the syntax of an Ada  identifier  (Ada  LRM
--    2.3).  The value of an attribute is a list of the format defined
--    by the  package  CAIS_list_utilities  (CAIS  1.4  section  5.4).
--    Upper  vs.  lower  case  distinctions are significant within the
--    value of attributes, but not within the attribute name.
--
--  Usage:
--  -----
--    The operations defined  for  the  manipipulation  of  attributes
--    identify  the  node  to  which  an  attribute  belongs either by
--    pathname or open node  handle.   They  identify  a  relationship
--    implicitly  by the last path element of a pathname or explicitly
--    by base node, key and relation name identification.
--
--  Example:
--  -------
--        To_List( "(""17NOV85"")", String_Value);
--        To_List( "(""14APR86"")", New_Value);
--          Create_Node_Attribute(Node, "DATE", String_Value);
--        Set_Node_Attribute   (Node, "DATE", New_Value);
--        Get_Node_Attribute   (Node, "DATE", String_Value);
--        Delete_Node_Attribute(Node, "DATE");
--
--        Node_Attribute_Iterate(Node, Iterator, "D*");
--        while More(Iterator) loop
--            Get_Next(Iterator, Attribute, Value);
--        end loop;
--
--  Notes:
--  -----
--    This is a version of the package CAIS_ATTRIBUTES,  specified  in
--    MIL-STD-CAIS section 5.1.3; all references to the CAIS specification
--    refer to the MIL-STD-CAIS specification dated 31 January 1985.
--
--  Revision History:
--  ----------------
--    12-04-85    Removed reference to V_String which is now hidden in
--            List_Utilities.  We now access To_Text(xx)'length
-------------------------------------------------------------------

separate(Cais)
package body Attributes is

    use List_Utilities;
    use Cais_Utilities;
    use Node_Definitions;
    use Node_Representation;
    use Node_Management;
    use Iterator_Support;
    use Identifier_Items;
----------------------   Initialize_Iterator   ---------------------------
--
--  Purpose: This procedure allocates a new list for an allocator and sets
--  -------  it to the Empty_List.  Position is set to zero.
--
--  Parameters:
--  ----------
--    Iterator      is the Attribute_Iterator to be itinialized
--
--  Exceptions:
--  ----------
--   None
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
    procedure Initialize_Iterator(Iterator : in out Attribute_Iterator) is
    begin
        Iterator.List := new List_Type;
        Iterator.Position := 0;
        Copy(Iterator.List.all, Empty_List);
    end Initialize_Iterator;
----------------------   Check_For_Open_Node   ---------------------------
--
--  Purpose: This procedure checks that a Node is indeed open
--  -------
--
--  Parameters:
--  ----------
--    Node      is the Node to be accessed
--
--  Exceptions:
--  ----------
--   STATUS-ERROR       is raised if the node handle is not open
--
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
    procedure Check_For_Open_Node(Node : in Node_Type) is
    begin
        if not Is_Open(Node) then
            raise Status_Error;
        end if;
    end Check_For_Open_Node;


----------------------   Validity_Check     ---------------------------------
--
--  Purpose: This procedure checks for valid availability of an attribute.
--  -------  It assures that the node is open with the proper intention and
--         that the attribute name is not one of those predefined.
--
--  Parameters:
--  ----------
--    Node      is the Node to be accessed
--    Intended  is the intent required by the callin routine
--    Attribute is the name of the attribute to be accessed
--
--  Exceptions:
--  ----------
--   USE_ERROR          is raised if the node already has an attribute of the
--                given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute.
--
--   STATUS-ERROR       is raised if the node handle is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the rights as
--            requested by the parameter intended.
--
--
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
    procedure Validity_Check(Node      : in Node_Type;
                             Intended  : in Intent_Specification;
                             Attribute : in Attribute_Name) is

    begin
        Check_For_Open_Node(Node);              --Status_Error check
        Check_Intentions(Node, Intended);       --Intent check
        if Predefined(Attribute, Cais_Utilities.Attribute) then
            raise Use_Error;
                          -- Use_Error if predefined
        end if;
    end Validity_Check;

----------------------   Create_Node_Attribute ----------------------
--
--  Purpose: This procedure creates an attribute named by ATTRIBUTE of
--  -------  of the node identified by the open node handle NODE and sets
--           its initial value to VALUE.
--
--  Parameters:
--  ----------
--    Node       is the open node handle being modified
--    Attribute  is the name of the attribute being added to this node
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   USE_ERROR          is raised if the node already has an attribute of the
--                given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute.
--
--   STATUS-ERROR       is raised if the node handle is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            append attributes.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.1
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.1
    procedure Create_Node_Attribute(  -- create attribute, set initial value
                                    Node      : in out Node_Type;
                                      -- open node handle for desired node
                                    Attribute : Attribute_Name;
                                      -- name of the attribute
                                    Value     : List_Type) is
                                      -- initial value of the attribute
        Top_Of_List    : Count := 0;
        Attribute_List : List_Type;

    begin
        Validity_Check(Node, Append_Attributes, Attribute);
        Get_Node_Attributes(Node, Attribute_List);
        Insert(Attribute_List, Value, Attribute, Top_Of_List);  --Use_Error is
                                                                --raised when
                                                                --appropriate
        Set_Node_Attributes(Node, Attribute_List);
    end Create_Node_Attribute;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for Relationship        --
-----------------------------------------------------------------------------
    procedure Create_Node_Attribute(  -- create attribute, set initial value
                                    Name      : Name_String;
                                   -- open node handle for desired node
                                    Attribute : Attribute_Name;
                                      -- name of the attribute
                                    Value     : List_Type) is
                                      -- initial value of the attribute
        Node : Node_Type;

    begin
        Open(Node, Name, (1 => Append_Attributes));
        Create_Node_Attribute(Node, Attribute, Value);
        Close(Node);
    exception
        when others =>
            Close(Node);
            raise;
    end Create_Node_Attribute;




----------------------  Create_Path_Attribute  ----------------------
--
--  Purpose: This procedure creates an attribnute named by ATTRIBUTE of
--  -------  of a relationship and sets its initial value to VALUE.  The
--         relationship is defined by the base node defined by the open
--         node handle BASE, the relation name RELATION, and the
--         relationship key KEY.
--
--  Parameters:
--  ----------
--    Base       is the open node handle of the base node
--    Key       is the relationship key of the affected relationship
--    Relation   is the relation name of the affected relationship
--    Attribute  is the name of the attribute added to this relationship
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   NAME_ERROR        is raised if the relationship identified by BASE, KEY,
--            and RELATION does not exist
--
--   USE_ERROR          is raised if the relationship already has an attribute
--            of the given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute
--            that cant be modified by the user. Use_Error is also
--            raised if RELATION is the name of a predefined relation
--            that can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle BASE is not open
--
--   INTENT_VIOLATION   is raised if BASE was not opened with the right to
--            write relationships.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.2
--  -----
--
---------------------------------------------------------------------

    -- CAIS 5.1.3.2
    procedure Create_Path_Attribute(    -- Create an attribute
                                    Base      : in out Node_Type;
                                     -- open node handle from which
                                     -- the relationship emanates
                                    Key       : Relationship_Key;
                                     -- key of affected relationship
                                    Relation  : Relation_Name :=
                                        Default_Relation;
                                     -- name of affected relationship
                                    Attribute : Attribute_Name;
                                     -- name of created attribute
                                    Value     : List_Type) is
                                     -- initial value of the attribute
        Attribute_List : List_Type;
        Top_Of_List    : constant Count := 0;
        Primary_Flag   : Boolean;
                                 --Returned by Get_A_Relationship and used by
        Shadow_File    : String(1 .. Pragmatics.Max_Shadow_File_Length);
                                                                     --*****:
                                                         --Set_A_Relationship

    begin
        Validity_Check(Base, Write_Relationships, Attribute);
        Get_A_Relationship(Base, Relation, Key, Shadow_File, Attribute_List,
                                                        --Triggers
        Primary_Flag);                                  --Name_Error
        Insert(Attribute_List, Value, Attribute, Top_Of_List);  --Use_Error is
                                                                --raised when
                                                                --appropriate
        Set_A_Relationship(Base, Relation, Key, Attribute_List, Primary_Flag,
            Shadow_File);
    exception
        when Cais_Internals_Exceptions.No_Such_Relationship |
            Cais_Internals_Exceptions.No_Such_Relation =>
            raise Name_Error;
    end Create_Path_Attribute;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
    procedure Create_Path_Attribute(    -- Create an attribute
                                    Name      : Name_String;
                                  -- name of affected relationship
                                    Attribute : Attribute_Name;
                                     -- name of created attribute
                                    Value     : List_Type) is
                                     -- initial value of the attribute
        Base : Node_Type;

    begin
        Open(Base, Base_Path(Name), (1 => Write_Relationships));
        Create_Path_Attribute(Base, Last_Key(Name), Last_Relation(Name),
            Attribute, Value);
        Close(Base);
    exception
        when others =>
            Close(Base);
            raise;
    end Create_Path_Attribute;

----------------------  Delete_Node_Attribute  ----------------------
--
--  Purpose: This procedure deletes an attribute named by ATTRIBUTE of
--  -------  of the node identified by the open node handle NODE.
--
--  Parameters:
--  ----------
--    Node       is the open node handle being modified
--    Attribute  is the name of the attribute being added to this node
--
--  Exceptions:
--  ----------
--   USE_ERROR          is raised if the node does not have an attribute of the
--                given name (or if the name given is syntactically
--                      illegal??) or is the name of a predefined node attribute
--            which can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            write attributes.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.3
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.3
    procedure Delete_Node_Attribute(   -- Delete an attribute
                                    Node      : in out Node_Type;
                                       -- open node handle for desired node
                                    Attribute : Attribute_Name) is
                                       -- name of the attribute to be deleted
        Attribute_List : List_Type;

    begin
        Validity_Check(Node, Write_Attributes, Attribute);
        Get_Node_Attributes(Node, Attribute_List);

        begin                                           --Raise Use_Error when
            Delete(Attribute_List, Attribute);          --Search_Error shows
        exception                                       --attribute doesn't
            when Search_Error =>                        --exist.
                raise Use_Error;
        end;

        Set_Node_Attributes(Node, Attribute_List);
    end Delete_Node_Attribute;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
    procedure Delete_Node_Attribute(  -- delete attribute
                                    Name      : Name_String;
                                      -- open node handle for desired node
                                    Attribute : Attribute_Name) is
                                      -- name of the attribute
        Node : Node_Type;

    begin
        Open(Node, Name, (1 => Write_Attributes));
        Delete_Node_Attribute(Node, Attribute);
        Close(Node);
    exception
        when others =>
            Close(Node);
            raise;
    end Delete_Node_Attribute;
----------------------  Delete_Path_Attribute  ----------------------
--
--  Purpose: This procedure creates an attribnute named by ATTRIBUTE of
--  -------  of a relationship and sets its initial value to VALUE.  The
--         relationship is defined by the base node defined by the open
--         node handle BASE, the relation name RELATION, and the
--         relationship key KEY.
--
--  Parameters:
--  ----------
--    Base       is the open node handle of the base node
--    Key       is the relationship key of the affected relationship
--    Relation   is the relation name of the affected relationship
--    Attribute  is the name of the attribute added to this relationship
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   NAME_ERROR        is raised if the relationship identified by BASE, KEY,
--            and RELATION does not exist
--
--   USE_ERROR          is raised if the relationship already has an attribute
--            of the given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute
--            that cant be modified by the user. Use_Error is also
--            raised if RELATION is the name of a predefined relation
--            that can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle BASE is not open
--
--   INTENT_VIOLATION   is raised if BASE was not opened with the right to
--            write relationships.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.4
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.4
    procedure Delete_Path_Attribute(    -- delete an attribute
                                    Base      : in out Node_Type;
                                        -- open node handle from which
                                        -- the relationship emanates
                                    Key       : Relationship_Key;
                                        -- key of affected relationship
                                    Relation  : Relation_Name :=
                                        Default_Relation;
                                        -- name of affected relationship
                                    Attribute : Attribute_Name) is
                                        -- name of created attribute
        Attribute_List : List_Type;
        Primary_Flag   : Boolean;
                                 --Returned by Get_A_Relationship and used by
        Shadow_File    : String(1 .. Pragmatics.Max_Shadow_File_Length);
                                                                     --*****:
                                                         --Set_A_Relationship

    begin
        Validity_Check(Base, Write_Relationships, Attribute);
        Get_A_Relationship(Base, Relation, Key, Shadow_File, Attribute_List,
                                                        --Triggers
        Primary_Flag);                                  --Name_Error

        begin                                           --Raise Use_Error when
            Delete(Attribute_List, Attribute);          --Search_Error shows
        exception                                       --attribute doesn't
            when Search_Error =>                        --exist.
                raise Use_Error;
        end;

        Set_A_Relationship(Base, Relation, Key, Attribute_List, Primary_Flag,
            Shadow_File);
    exception
        when Cais_Internals_Exceptions.No_Such_Relationship |
            Cais_Internals_Exceptions.No_Such_Relation =>
            raise Name_Error;
    end Delete_Path_Attribute;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for Relationship        --
-----------------------------------------------------------------------------
    procedure Delete_Path_Attribute(    -- Delete an attribute
                                    Name      : Name_String;
                                                -- Node name
                                    Attribute : Attribute_Name) is
                                        -- name of created attribute
        Base : Node_Type;

    begin
        Open(Base, Base_Path(Name), (1 => Write_Relationships));
        Delete_Path_Attribute(Base, Last_Key(Name), Last_Relation(Name),
            Attribute);
        Close(Base);
    exception
        when others =>
            Close(Base);
            raise;
    end Delete_Path_Attribute;
----------------------SET_NODE_ATTRIBUTE-----------------------------
--
--  Purpose: This procedure deletes an attribute named by ATTRIBUTE of
--  -------  of the node identified by the open node handle NODE.
--
--  Parameters:
--  ----------
--    Node       is the open node handle being modified
--    Attribute  is the name of the attribute being added to this node
--
--  Exceptions:
--  ----------
--   USE_ERROR          is raised if the node does not have an attribute of the
--                given name (or if the name given is syntactically
--                      illegal??) or is the name of a predefined node attribute
--            which can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            write attributes.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.5
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.5
    procedure Set_Node_Attribute(      -- Set the value of existing attribute
                                 Node      : in out Node_Type;
                                         -- open node handle
                                 Attribute : Attribute_Name;
                                         -- name of attribute to be set
                                 Value     : List_Type) is
                                         -- new value of attribute
        Attribute_List : List_Type;
    begin
        Validity_Check(Node, Write_Attributes, Attribute);
        Get_Node_Attributes(Node, Attribute_List);

        begin                                           --Raise Use_Error when
            Replace(Attribute_List, Value, Attribute);  --Search_Error shows
        exception                                       --attribute doesn't
            when Search_Error =>                        --exist.
                raise Use_Error;
        end;

        Set_Node_Attributes(Node, Attribute_List);
    end Set_Node_Attribute;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
    procedure Set_Node_Attribute(  -- set the value of a node attribute
                                 Name      : Name_String;
                                        -- Node name
                                 Attribute : Attribute_Name;
                                        -- name of the attribute
                                 Value     : List_Type) is
                                        -- initial value of the attribute
        Node : Node_Type;

    begin
        Open(Node, Name, (1 => Write_Attributes));
        Set_Node_Attribute(Node, Attribute, Value);
        Close(Node);
    exception
        when others =>
            Close(Node);
            raise;
    end Set_Node_Attribute;
----------------------    Set_Path_Attribute   ----------------------
--
--  Purpose: This procedure creates an attribnute named by ATTRIBUTE of
--  -------  of a relationship and sets its initial value to VALUE.  The
--         relationship is defined by the base node defined by the open
--         node handle BASE, the relation name RELATION, and the
--         relationship key KEY.
--
--  Parameters:
--  ----------
--    Base       is the open node handle of the base node
--    Key       is the relationship key of the affected relationship
--    Relation   is the relation name of the affected relationship
--    Attribute  is the name of the attribute added to this relationship
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   NAME_ERROR        is raised if the relationship identified by BASE, KEY,
--            and RELATION does not exist
--
--   USE_ERROR          is raised if the relationship already has an attribute
--            of the given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute
--            that cant be modified by the user. Use_Error is also
--            raised if RELATION is the name of a predefined relation
--            that can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle BASE is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            write relationships.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.6
--  -----
--
---------------------------------------------------------------------

    -- CAIS 5.1.3.6
    procedure Set_Path_Attribute(    -- Set the value of an existing attribute
                                 Base      : in out Node_Type;
                                        -- open node handle from which
                                        -- the relationship emanates
                                 Key       : Relationship_Key;
                                        -- key of affected relationship
                                 Relation  : Relation_Name := Default_Relation;
                                        -- name of affected relationship
                                 Attribute : Attribute_Name;
                                        -- name of created attribute
                                 Value     : List_Type) is
                                        -- new value of attribute
        Attribute_List : List_Type;
        Primary_Flag   : Boolean;
                                 --Returned by Get_A_Relationship and used by
        Shadow_File    : String(1 .. Pragmatics.Max_Shadow_File_Length);
                                                                     --*****:
                                                         --Set_A_Relationship
    begin
        Validity_Check(Base, Write_Relationships, Attribute);
        Get_A_Relationship(Base, Relation, Key, Shadow_File, Attribute_List,
                                                        --Triggers
        Primary_Flag);                                  --Name_Error

        begin                                           --Raise Use_Error when
            Replace(Attribute_List, Value, Attribute);  --Search_Error shows
        exception                                       --attribute doesn't
            when Search_Error =>                        --exist.
                raise Use_Error;
        end;

        Set_A_Relationship(Base, Relation, Key, Attribute_List, Primary_Flag,
            Shadow_File);
    exception
        when Cais_Internals_Exceptions.No_Such_Relationship |
            Cais_Internals_Exceptions.No_Such_Relation =>
            raise Name_Error;
    end Set_Path_Attribute;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
    procedure Set_Path_Attribute(    -- Set the value of a path attribute
                                 Name      : Name_String;
                                     -- name of affected relationship
                                 Attribute : Attribute_Name;
                                     -- name of created attribute
                                 Value     : List_Type) is
                                     -- initial value of the attribute
        Base : Node_Type;

    begin
        Open(Base, Base_Path(Name), (1 => Write_Relationships));
        Set_Path_Attribute(Base, Last_Key(Name), Last_Relation(Name), Attribute
            , Value);
        Close(Base);
    exception
        when others =>
            Close(Base);
            raise;
    end Set_Path_Attribute;
----------------------    Get_Node_Attribute   ----------------------
--
--  Purpose: This procedure deletes an attribute named by ATTRIBUTE of
--  -------  of the node identified by the open node handle NODE.
--
--  Parameters:
--  ----------
--    Node       is the open node handle being modified
--    Attribute  is the name of the attribute being added to this node
--
--  Exceptions:
--  ----------
--   USE_ERROR          is raised if the node does not have an attribute of the
--                given name (or if the name given is syntactically
--                      illegal??) or is the name of a predefined node attribute
--            which can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            read attributes.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.7
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.7
    procedure Get_Node_Attribute(     -- get the value of a node attribute
                                 Node      : Node_Type;
                                         -- open node handle for desired node
                                 Attribute : Attribute_Name;
                                         -- name of created attribute
                                 Value     : in out List_Type) is
                                         -- result parm containing the value
        Attribute_List : List_Type;
    begin
        Validity_Check(Node, Read_Attributes, Attribute);
        Get_Node_Attributes(Node, Attribute_List);

        begin                                           --Raise Use_Error when
            Extract(Attribute_List, Attribute, Value);  --Search_Error shows
        exception                                       --attribute doesn't
            when Search_Error =>                        --exist.
                raise Use_Error;
        end;

    end Get_Node_Attribute;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
    procedure Get_Node_Attribute(  -- Retrieve value of a node attribute
                                 Name      : Name_String;
                                        -- Node name
                                 Attribute : Attribute_Name;
                                        -- name of the attribute
                                 Value     : in out List_Type) is
                                         -- initial value of the attribute
        Node : Node_Type;

    begin
        Open(Node, Name, (1 => Read_Attributes));
        Get_Node_Attribute(Node, Attribute, Value);
        Close(Node);
    exception
        when others =>
            Close(Node);
            raise;
    end Get_Node_Attribute;
----------------------   Get_Path_Attribute    ----------------------
--
--  Purpose: This procedure creates an attribnute named by ATTRIBUTE of
--  -------  of a relationship and sets its initial value to VALUE.  The
--         relationship is defined by the base node defined by the open
--         node handle BASE, the relation name RELATION, and the
--         relationship key KEY.
--
--  Parameters:
--  ----------
--    Base       is the open node handle of the base node
--    Key       is the relationship key of the affected relationship
--    Relation   is the relation name of the affected relationship
--    Attribute  is the name of the attribute added to this relationship
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   NAME_ERROR        is raised if the relationship identified by BASE, KEY,
--            and RELATION does not exist
--
--   USE_ERROR          is raised if the relationship already has an attribute
--            of the given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute
--            that cant be modified by the user. Use_Error is also
--            raised if RELATION is the name of a predefined relation
--            that can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle BASE is not open
--
--   INTENT_VIOLATION   is raised if BASE was not opened with the right to
--            read relationships.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.8
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.8
    procedure Get_Path_Attribute(    -- get the value of a path attribute
                                 Base      : Node_Type;
                                        -- open node handle from which
                                        -- the relationship emanates
                                 Key       : Relationship_Key;
                                        -- key of affected relationship
                                 Relation  : Relation_Name := Default_Relation;
                                         -- name of affected relationship
                                 Attribute : Attribute_Name;
                                         -- name of created attribute
                                 Value     : in out List_Type) is
                                         -- result parm containing the value
        Attribute_List : List_Type;
        Primary_Flag   : Boolean; --Returned by Get_A_Relationship but not used
        Shadow_File    : String(1 .. Pragmatics.Max_Shadow_File_Length);
                                                                        --DITTO
    begin
        Validity_Check(Base, Read_Relationships, Attribute);
        Get_A_Relationship(Base, Relation, Key, Shadow_File, Attribute_List,
                                                        --Triggers
        Primary_Flag);                                  --Name_Error

        begin                                           --Raise Use_Error when
            Extract(Attribute_List, Attribute, Value);  --Search_Error shows
        exception                                       --attribute doesn't
            when Search_Error =>                        --exist.
                raise Use_Error;
        end;

    exception
        when Cais_Internals_Exceptions.No_Such_Relationship |
            Cais_Internals_Exceptions.No_Such_Relation =>
            raise Name_Error;
    end Get_Path_Attribute;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for Relationship        --
-----------------------------------------------------------------------------
    procedure Get_Path_Attribute(    -- Retrieve the value of a path attribute
                                 Name      : Name_String;
                                     -- Node name
                                 Attribute : Attribute_Name;
                                        -- name of desired attribute
                                 Value     : in out List_Type) is
                                        -- initial value of the attribute
        Base : Node_Type;

    begin
        Open(Base, Base_Path(Name), (1 => Read_Relationships));
        Get_Path_Attribute(Base, Last_Key(Name), Last_Relation(Name), Attribute
            , Value);
        Close(Base);
    exception
        when others =>
            Close(Base);
            raise;
    end Get_Path_Attribute;
--------------------------NODE_ATTRIBUTE_ITERATE---------------------
--
--  Purpose:  Creates a set of attributes from the named node which
--  -------   match the provided pattern containing wild card characters
--            '*' to match any string and '?' to match any character.
--
--  Parameters:
--  ----------
--   Iterator is the set of matching attributes
--   Node     is the node whose attributes are searched for matches
--   Pattern  is the string (with * and ?) which determines matches
--
--  Exceptions:
--  ----------
--   Use_Error        is raised if the Pattern is syntactically illegal
--
--   Status_Error     is raised if the node is not an open node handle
--
--   Intent_Violation is rasied if Node is not open with the right to
--              read attributes.
--
--  Notes: MIL-STD CAIS 5.1.3.10
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.10
    procedure Node_Attribute_Iterate(    -- get an attribute iterator
                                     Iterator : in out Attribute_Iterator;
                                               -- see CAIS 1.4 5.1.3 for expl.)
                                     Node     : Node_Type;
                                     -- open node handle for desired node
                                     Pattern  : Attribute_Pattern := "*") is
                                                  -- pattern for attr. names
        Attribute_List : List_Type;
        Token_Name     : Token_Type;
        Value          : List_Type;
        Size           : Integer := 0;
    begin
        Verify_Pattern(Pattern, Size);                  --Use_Error check
        Check_For_Open_Node(Node);                      --Status_Error check
        Check_Intentions(Node, Read_Attributes);        --Intent check
        Get_Node_Attributes(Node, Attribute_List);

        Initialize_Iterator(Iterator);

        for I in 1 .. Length(Attribute_List) loop
            Item_Name(Attribute_List, I, Token_Name);
            if Pattern_Match(To_Text(Token_Name), Pattern(Pattern'First .. Size)
                ) then
                Extract(Attribute_List, I, Value);
                Insert(Iterator.List.all, Value, Token_Name, Lexical_Position(
                    Iterator.List.all, Token_Name));
            end if;
        end loop;
    end Node_Attribute_Iterate;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
    procedure Node_Attribute_Iterate(  -- create iterator over set of attributes
                                     Iterator : in out Attribute_Iterator;
                                               --set being created
                                     Name     : Name_String;
                                               --node from which set is built
                                     Pattern  : Attribute_Pattern := "*") is
                                               --set descriptor
        Node : Node_Type;

    begin
        Open(Node, Name, (1 => Read_Attributes));
        Node_Attribute_Iterate(Iterator, Node, Pattern);
        Close(Node);
    exception
        when others =>
            Close(Node);
            raise;
    end Node_Attribute_Iterate;
----------------------  Path_Attribute_Iterate  ----------------------
--
--  Purpose:  Creates a set of attributes from the named path which
--  -------   match the provided pattern containing wild card characters
--            '*' to match any string and '?' to match any character.
--
--  Parameters:
--  ----------
--   Iterator is the set of matching attributes
--   Base     is the open node handle from which the relationship emanates
--   Key      is the key of the affected relationship
--   Relation is the name of the affected relationship
--   Pattern  is the string (with * and ?) which determines matches
--
--  Exceptions:
--  ----------
--   Use_Error        is raised if the Pattern is syntactically illegal
--
--   Status_Error     is raised if the node is not an open node handle
--
--   Intent_Violation is rasied if Node is not open with the right to
--              read relationships.
--
--  Notes: MIL-STD CAIS 5.1.3.11
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.11
    procedure Path_Attribute_Iterate(  -- get iterator over relationship attr.
                                     Iterator : in out Attribute_Iterator;
                                              -- see CAIS 1.4 5.1.3 for expl.)
                                     Base     : Node_Type;
                                        -- open node handle from which
                                        -- the relationship emanates
                                     Key      : Relationship_Key;
                                        -- key of the relationship
                                     Relation : Relation_Name :=
                                         Default_Relation;
                                        -- name of the relationship
                                     Pattern  : Attribute_Pattern := "*") is
                                                 -- pattern for attr. names
        Attribute_List : List_Type;
        Token_Name     : Token_Type;
        Value          : List_Type;
        Primary_Flag   : Boolean; --Return by Get_A_Relationship but not used
        Shadow_File    : String(1 .. Pragmatics.Max_Shadow_File_Length);
                                                                       --DITTO
        Size           : Integer := 0;

    begin
        Verify_Pattern(Pattern, Size);                  --Use_Error check
        Check_For_Open_Node(Base);                      --Status_Error check
        Check_Intentions(Base, Read_Relationships);     --Intent check
        Get_A_Relationship(Base, Relation, Key, Shadow_File, Attribute_List,
                                                        --Triggers
        Primary_Flag);                                  --Name_Error
        Initialize_Iterator(Iterator);

        for I in 1 .. Length(Attribute_List) loop
            Item_Name(Attribute_List, I, Token_Name);
            if Pattern_Match(To_Text(Token_Name), Pattern(Pattern'First .. Size)
                ) then
                Extract(Attribute_List, I, Value);
                Insert(Iterator.List.all, Value, Token_Name, Lexical_Position(
                    Iterator.List.all, Token_Name));
            end if;
        end loop;
    exception
        when Cais_Internals_Exceptions.No_Such_Relationship |
            Cais_Internals_Exceptions.No_Such_Relation =>
            raise Name_Error;
    end Path_Attribute_Iterate;

-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
    procedure Path_Attribute_Iterate(    -- build iteration set
                                     Iterator : in out Attribute_Iterator;
                                                --set being built
                                     Name     : Name_String;
                                             --name of affected relationship
                                     Pattern  : Attribute_Pattern := "*") is
                                             --determines selected attributes
        Base : Node_Type;

    begin
        Open(Base, Base_Path(Name), (1 => Read_Relationships));
        Path_Attribute_Iterate(Iterator, Base, Last_Key(Name), Last_Relation(
            Name), Pattern);
        Close(Base);
    exception
        when others =>
            Close(Base);
            raise;
    end Path_Attribute_Iterate;
----------------------          More           ----------------------
--
--  Purpose: The function More returns false if all attributes contained
--  -------  in the attribute iterator have been retrieved with the procedure
--         Get_Next; otherwise, it returns true.
--
--  Parameters:
--  ----------
--    Iterator is a previously constructed attribute iterator.
--
--  Exceptions:
--  ----------
--    Use_Error is raised if the iterator has not been previously set by the
--        procedure Node_Attribute_Iterate or Path_Attribute_Iterate.
--
--  Notes: MIL-STD CAIS 5.1.3.12
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.12
    function More(  -- indicate if all attr. have been retrieved via Get_Next
                  Iterator : in Attribute_Iterator)
                                         -- previously constructed iterator
    return Boolean is

        Dummy : Boolean;    -- for return statement in stub only
    begin
        if Iterator.Position < 0 or else Iterator.List = null or else Iterator.
            Position > Length(Iterator.List.all) then
            raise Use_Error;        --Poorly formed Iterator;
        else
            return Iterator.Position /= Length(Iterator.List.all);
        end if;
    end More;
----------------------          Get_Next       ----------------------
--
--  Purpose: Returns, in the parameters Attribute and Value, both the name
--  -------  and the value of the next attribute in the iterator.
--
--  Parameters:
--  ----------
--    Iterator  is a previously constructed iterator.
--    Attribute contains the name of the retrieved attribute.
--    Value     contains the value of the attribute named by Attribute.
--
--  Exceptions:
--  ----------
--    Use_Error is raised if the Iterator has not been previously set by the
--        procedure Node_Attribute_Iterate or Path_Attribute_Iterate or if the
--        iterator is exhausted, i.e., More(Iterator) = false.
--
--  Notes: MIL-STD CAIS 5.1.3.13
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.13
    procedure Get_Next(   -- get name and value of next attribute  in iterator
                       Iterator  : in out Attribute_Iterator;
                                               -- see CAIS 1.4 5.1.3 for expl.)
                       Attribute : in out Attribute_Name;
                                                  -- name of next attribute
                       Value     : in out List_Type) is
                                               -- value of next attribute
        Token_Name : Token_Type;        --Attribute name in token form
        Len        : Natural;

    begin
        if Iterator.Position < 0 or else Iterator.List = null or else Iterator.
            Position >= Length(Iterator.List.all) then
            raise Use_Error;    --Poorly formed or exhausted Iterator
        else
            Iterator.Position := Iterator.Position + 1;
                                                     --point to next value
            Extract(Iterator.List.all, Iterator.Position, Value);
            Item_Name(Iterator.List.all, Iterator.Position, Token_Name);
            Len := To_Text(Token_Name)'Length;
            Attribute(Attribute'range ) := (others => ' ');
            Attribute(Attribute'First .. Attribute'First + Len - 1) := To_Text(
                Token_Name);
        end if;
    end Get_Next;
---------------------------------------------------------------------------
end Attributes; --END OF PACKAGE BODY
---------------------------------------------------------------------------
--::::::::::::::
--cais_body.a
--::::::::::::::
with Calendar;
with Generic_List;
with Trace; use Trace;

package body Cais is


    type Node_Rec is
        record
            Kind            : Node_Definitions.Node_Kind;
            Pathname        : String(1 .. Pragmatics.Max_Name_String);
            Open_Intent     : Node_Definitions.Intention(Pragmatics.Intent_Count
                );
            Intent_Size     : Pragmatics.Intent_Count;
            Shadow_File     : String(1 .. Pragmatics.Max_Shadow_File_Length) :=
                (others => ' ');
            Contents_File   : String(1 .. Pragmatics.Max_Shadow_File_Length) :=
                (others => ' ');
            Node_Attributes : List_Utilities.List_Type;
            Node_Relations  : List_Utilities.List_Type;
            Access_Control  : List_Utilities.List_Type;
            Node_Level      : List_Utilities.List_Type;
            Open_Status     : Boolean := False;
        end record;
-- These list items are preset in the package body at elaboration to
-- contain the names of all CAIS predefined attributes and relations.
    Predefined_Attributes : List_Utilities.List_Type;
    Predefined_Relations  : List_Utilities.List_Type;

----------------------------------------------------------------------
--            C A I S _ I N T E R N A L S _ E X C E P T I O N S
--
--
--       Definitions of exceptions raised by CAIS implementation code
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Tue May 21 11:20:56 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--            C A I S _ I N T E R N A L S _ E X C E P T I O N S
--
--  Purpose:
--  -------
--    This package is simply the collection of exceptions used internally
--    in the CAIS prototype.
--
--  Usage:
--  -----
--    The exceptions declared here are used any any other exceptions;
--    they are explicitly raised under certain conditions in internals
--    code, and trapped by exception handlers that either map them onto
--    cais_defined exceptions or attempt recovery.
--
--  Example:
--  -------
--    raise List_Too_Long;
--
--  Notes:
--  -----
--    None.
--
--  Revision History:
--  ----------------
--    None.
--
-------------------------------------------------------------------
    package Cais_Internals_Exceptions is

        Pathname_Syntax_Error : exception;
        No_Such_Component     : exception;
        Pn_Parser_Error       : exception;
        Internal_Error        : exception;
        No_Such_User          : exception;
        Shadow_File_Error     : exception;
        Content_File_Error    : exception;
        List_Too_Long         : exception;
        Cais_Userid_Undefined : exception;
        No_Such_Relation      : exception;
        No_Such_Relationship  : exception;
        No_Such_Shadow_File   : exception;

    end Cais_Internals_Exceptions;

----------------------------------------------------------------------
--        N O D E _ R E P R E S E N T A T I O N
--
--  Function:
--  --------
--      This package provides the subprograms
--      used by other components of the CAIS implementation for
--      manipulation of objects of type Node_Type.
--
--  Usage:
--  -----
--    TBS
--
--  Example:
--  -------
--    TBS
--
--  Notes:
--  -----
--
--  Revision History:
--  ----------------
--
----------------------------------------------------------------------

    package Node_Representation is

        use List_Utilities;
        use Node_Definitions;


        Null_Rel_Key : constant String := "C_A_I_S_N_U_L_L_K_E_Y";
        Primary_Rel  : constant String := "C_A_I_S_P_R_I_M_A_R_Y";

        type Pn_Rec is
            record
                Rel_Name   : String(1 .. Pragmatics.Max_Token_Size) := (others
                    => ' ');
                Rel_Key    : String(1 .. Pragmatics.Max_Token_Size) := (others
                    => ' ');
                Latest_Key : Boolean := False;
            end record;

        package Pn_Comp_List is
            new Generic_List(Pn_Rec);
        use Pn_Comp_List;

        type Parsed_Pn is
            record
                L : Pn_Comp_List.List;
            end record;


----------------------   I N I T _ N O D E     ----------------------
--
--  Purpose:
--  -------
--    Initialize an object of type Node_Type prior to use.
--
--  Parameters:
--  ----------
--    Node  - the node object to be initialized
--
--  Exceptions:
--  ----------
--    None
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Init_Node(Node : in out Node_Type);

---------------------         G E T _ K I N D   ---------------------
--
--  Purpose:
--  -------
--    Extract the Node_Kind component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error if the node is not initialized.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        function Get_Kind(Node : Node_Type) return Node_Kind;

---------------------  G E T _ P A T H N A M E  ---------------------
--
--  Purpose:
--  -------
--    Extract the Pathname component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error if the node is not initialized.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Get_Pathname(Node     : Node_Type;
                               Name     : in out String;
                               Lastchar : in out Natural);
                                    -- offset of last char returned

---------------------         G E T _ I N T E N T -------------------
--
--  Purpose:
--  -------
--    Extract the Intention component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--
--  Exceptions:
--  ----------
--    Node_Definitions.STATUS_ERROR if the node is not initialized.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        function Get_Intent(Node : Node_Type) return Intention;

-----------         G E T _ S H A D O W _ F I L E _ N A M E ---------
--
--  Purpose:
--  -------
--    Extract the Shadow file name component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--
--  Exceptions:
--  ----------
--    Node_Definitions.STATUS_ERROR if the node is not initialized.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Get_Shadow_File_Name(Node     : Node_Type;
                                       Name     : in out String;
                                       Lastchar : in out Natural);
                                    -- offset of last char returned

-----------     G E T _ C O N T E N T S _ F I L E _ N A M E ---------
--
--  Purpose:
--  -------
--    Extract the Contents file name component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--
--  Exceptions:
--  ----------
--    Node_Definitions.STATUS_ERROR if the node is not initialized.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Get_Contents_File_Name(Node     : Node_Type;
                                         Name     : in out String;
                                         Lastchar : in out Natural);
                                    -- offset of last char returned

----------------  G E T _ N O D E _ A T T R I B U T E S  ------------
--
--  Purpose:
--  -------
--    Extract the node attributes component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    Attributes - the list containing the node attributes extracted
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error if the node is not initialized.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Get_Node_Attributes(Node       : Node_Type;
                                      Attributes : in out List_Type);

----------------  G E T _ N O D E _ R E L A T I O N S  --------------
--
--  Purpose:
--  -------
--    Extract the node relations component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    Relations - the list containing the node relations extracted
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error if the node is not initialized.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Get_Node_Relations(Node      : Node_Type;
                                     Relations : in out List_Type);

---------------  G E T _ A _ R E L A T I O N  -----------------------
--
--  Purpose:
--  -------
--    This procedure returns the list containing all of the internal
--    data structures associated with a specific node relation.
--
--  Parameters:
--  ----------
--    Node      - node_type of node from which the relation emanates.
--    Rel_Name  - The name of the relation
--    Rel_List  - the list returned containing all of the data structures.
--
--  Exceptions:
--  ----------
--    Status_Error   - if "Node" was not initialized
--    Cais_Internals_Exceptions.No_Such_Relation  - if "Rel_Name" does
--        not refer to an existing relation emanating from "Node".
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Get_A_Relation(Node     : Node_Type;
                                 Rel_Name : String;
                                 Rel_List : in out List_Type);

-------------  G E T _ A _ R E L A T I O N I ON S H I P -------------
--
--  Purpose:
--  -------
--    This procedure returns all of the internal data structures associated
--    with a specific node relationionship.
--
--  Parameters:
--  ----------
--    Node      - node_type of node from which the relation emanates.
--    Rel_Name  - The name of the relation
--    Rel_Key   - The name of the relationship key
--    Rel_Attributes - all of the relationship attributes as a list
--    Primary   - Boolean indicating if this is a primary relationship
--    Shadow_File  - host name of the shadow file for this relationship
--
--  Exceptions:
--  ----------
--    Status_Error   - if "Node" was not initialized
--    Cais_Internals_Exceptions.No_Such_Relation  - if "Rel_Name" does
--        not refer to an existing relation emanating from "Node".
--    Cais_Internals_Exceptions.No_Such_Relationship  - if "Rel_Name" and
--        "Rel_Key" together do not refer to an existing relationship
--        emanating from "Node".
--    Cais_Internals_Exceptions.Internal_Error  - if the shadow file
--        structure has become corrupted.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Get_A_Relationship(Node           : Node_Type;
                                     Rel_Name       : String;
                                     Rel_Key        : String;
                                     Shadow_File    : in out String;
                                     Rel_Attributes : in out List_Type;
                                     Primary        : in out Boolean);

------------  G E T _ N O D E _ A C C E S S _ C O N T R O L ---------
--
--  Purpose:
--  -------
--    Extract the access control component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    AccList - the list containing the access control information extracted
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error if the node is not initialized.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Get_Node_Access_Control(Node    : Node_Type;
                                          Acclist : in out List_Type);

----------------  G E T _ N O D E _ L E V E L    --------------------
--
--  Purpose:
--  -------
--    Extract the node level component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    Level - the list containing the node level extracted
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error if the node is not initialized.
--
--  Notes:
--  -----
--    Level refers to the classification attribute values associated with
--    the node, as described in MIL-STD-CAIS 4.4.3.  Mandatory access
--    control is NOT implemented in the MITRE prototype.
--
---------------------------------------------------------------------
        procedure Get_Node_Level(Node  : Node_Type;
                                 Level : in out List_Type);

-----------     S E T _ N O D E _ A T T R I B U T E S   -------------
--
--  Purpose:
--  -------
--    Set the node attributes component in an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node        -  The object of type Node_Type
--    Attributes  -  The attributes list to be assigned
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Set_Node_Attributes(Node       : in out Node_Type;
                                      Attributes : List_Type);

-----------     S E T _ N O D E _ R E L A T I O N S   ---------------
--
--  Purpose:
--  -------
--    Set the node relations component in an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node        -  The object of type Node_Type
--    relations   -  The relations list to be assigned
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
    -- if the relation does not exist, it is created.
    -- if the relation exists, it is replaced.
        procedure Set_Node_Relations(Node      : in out Node_Type;
                                     Relations : List_Type);

--------------     S E T _ A _ R E L A T I O N S H I P   ---------------
--
--  Purpose:
--  -------
--    Set the values for a specific node relationship
--
--  Parameters:
--  ----------
--    Node        - Node handle of node to be accessed
--    Rel_Name    - relation name of the relationship to be set
--    Rel_Key     - relation key of the relationship to be set
--    Rel_Attributes - relationship attributes of the relationship to be set
--    Primary     - Boolean indicating if the relationship is primary
--    Shadow_File - fully qualified name of host shadow file
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
    -- if the relation does not exist, it is created.
    -- if the relationship exists, it is replaced.
        procedure Set_A_Relationship(Node           : in out Node_Type;
                                     Rel_Name       : String;
                                     Rel_Key        : String;
                                     Rel_Attributes : List_Type;
                                     Primary        : Boolean;
                                     Shadow_File    : String);

----------------- D E L E T E _ A _ R E L A T I O N S H I P ---------
--
--  Purpose:
--  -------
--    This procedure deletes a specific relationship from the
--    relationships emanating from the node.
--
--  Parameters:
--  ----------
--    Node      - Node handle for specified node
--    Rel_Name  - relation name for relationship to be deleted
--    Rel_Key   - relation key for relationship to be deleted
--
--  Exceptions:
--  ----------
--    No_Such_Relation      - if the relation name does not refer to an
--                            existing node relation.
--    No_Such_Relationship  - if the relation name and key do not refer
--                            to an existing node relationship.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Delete_A_Relationship(Node     : in out Node_Type;
                                        Rel_Name : String;
                                        Rel_Key  : String);

------------  S E T _ N O D E _ A C C E S S _ C O N T R O L ---------
--
--  Purpose:
--  -------
--    Set the access control component from an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    AccList - the list containing the access control information
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Set_Node_Access_Control(Node    : in out Node_Type;
                                          Acclist : List_Type);

----------------  S E T _ N O D E _ L E V E L    --------------------
--
--  Purpose:
--  -------
--    Set the node level component of an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    Level - the list containing the node level
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    Level refers to the classification attribute values associated with
--    the node, as described in MIL-STD-CAIS 4.4.3.  Mandatory access
--    control is NOT implemented in the MITRE prototype.
--
---------------------------------------------------------------------
        procedure Set_Node_Level(Node  : in out Node_Type;
                                 Level : List_Type);


---------------------         S E T _ K I N D   ---------------------
--
--  Purpose:
--  -------
--    Extract the Node_Kind component in an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    Kind  - the value to be assigned
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Set_Kind(Node : in out Node_Type;
                           Kind : Node_Kind);

---------------------         S E T _ P N       ---------------------
--
--  Purpose:
--  -------
--    Set the Parsed_PN component in an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    PN    -  the value to be assigned
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Set_Pathname(Node     : in out Node_Type;
                               Pathname : String);

--------------------    S E T _ I N T E N T    ----------------------
--
--  Purpose:
--  -------
--    Set the Intention component in an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    Open_Intent - The value to be assigned
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    The code in this procedure reflects the implementation convention
--    that the Intent array of a node is of the fixed length
--    Pragmatics.Intent_Count, and that the offset of the last
--    element in this array that is assigned a value from the Intention
--    given by the user in the Open call is stored in Node.Intent_Size.
--
---------------------------------------------------------------------
        procedure Set_Intent(Node        : in out Node_Type;
                             Open_Intent : Intention);

-----------         S E T _ S H A D O W _ F I L E _ N A M E ---------
--
--  Purpose:
--  -------
--    Set the Shadow file name component in an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    Shadow_File - the value to be assigned
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Set_Shadow_File_Name(Node : in out Node_Type;
                                       Name : String);
                        -- left justified, padded w/ blanks

-----------     S E T _ C O N T E N T S _ F I L E _ N A M E ---------
--
--  Purpose:
--  -------
--    Set the Contents file name component in an object of the
--    limited private type Node_Type.
--
--  Parameters:
--  ----------
--    Node  -  The object of type Node_Type
--    Name  - the value to be assigned
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Set_Contents_File_Name(Node : in out Node_Type;
                                         Name : String);
                        -- left justified, padded w/ blanks

------------------    O P E N _ S T A T U S     ---------------------
--
--  Purpose:
--  -------
--    This Boolean function returns the current open status of the
--    specified node (True if open, False if not open).
--
--  Parameters:
--  ----------
--    Node  - node handle to be examined.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        function Open_Status(Node : Node_Type) return Boolean;

----------------------   S E T _ O P E N     ------------------------
--
--  Purpose:
--  -------
--    This procedure sets the open status of the specified node
--    according to the Boolean variable "Status".
--
--  Parameters:
--  ----------
--    Node   - Node handle to be affected
--    Status - Boolean that indicates the new open status of the
--             node (True = open, False = closed).
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Set_Open(Node   : in out Node_Type;
                           Status : Boolean);


    end Node_Representation;


----------------------------------------------------------------------
--        N O D E _ I N T E R N A L S
--
--  Purpose:
--  -------
--      This package provides services to work with CAIS pathnames
--      and to support the implementation of CAIS nodes.
--
--  Usage:
--  -----
--    TBS
--
--  Example:
--  -------
--    TBS
--
--  Notes:
--  -----
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------

    package Node_Internals is

        use Node_Representation;
        use Node_Definitions;
        use List_Utilities;


----------------------  C R E A T E _ N O D E  ----------------------
--
--  Purpose:
--  -------
--    This procedure creates a node and installs the
--    primary relationship to it.  The relation name and relationship
--    key of the primary relationship to the node and the base node
--    from which it emanates are given by the parameters Relation,
--    Key, and Base.  An open node handle to the newly created node
--    with Write intent is returned in Node.
--
--  Parameters:
--  ----------
--    Node        closed node handle to be opened to the new node
--    Base        open node handle to the node from which the primary
--                relationship to the new node is to emanate
--    Kind        the Node_Kind of the new node
--    Internals_Attributes  Node attributes that are NOT settable
--                by the user or that are part of the implementation.
--    User_Attributes  Node attributes that are settable by the user.
--    Key         relationship key of the primary relation to be created
--    Relation    relation name of the primary relation to be created
--
--  Exceptions:  (All Node_Definitions.-)
--  ----------
--    Name_Error        - if a node exists for the node identification
--                        given, if the node identification is illegal.
--    Security_Violation  if the operation violates mandatory access
--                        controls; raised only if conditions for other
--                        exceptions are not met.
--    Use_Error         if the User_Attributes list includes invalid
--                      node attributes or attributes not user-settable.
--
--  Notes:
--  -----
--     The calling routine is responsible for creating the
--     contents file if this is a File node.
--
---------------------------------------------------------------------


        procedure Create_Node(Node                 : in out Node_Type;
                              Base                 : in out Node_Type;
                              Kind                 : Node_Kind;
                              Internals_Attributes : List_Type;
                              User_Attributes      : List_Type;
                              Internals_Relations  : List_Type;
                              Intent               : Intention;
                              Access_Control       : List_Type;
                              Level                : List_Type;
                              Key                  : String;
                              Relation             : String);


--------------------    R E A D _ S H A D O W _ F I L E   ------------
--
--  Purpose:
--  -------
--    This procedure loads a node handle with the information stored
--    in a shadow file.
--
--  Parameters:
--  ----------
--    Node  - Node_Type
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.List_Too_Long  - if the text representation
--        of a list stored in the shadow file is too long (i.e. >
--        Pragmatics.Max_List_Length).
--    Cais_Internals_Exceptions.No_Such_Shadow_File  - if the shadow file
--        name given does not correspond to an accessable host file.
--
--  Notes:
--  -----
--    The fully qualified host file name for the shadow file must be
--    in the node handle already.
--
---------------------------------------------------------------------
        procedure Read_Shadow_File(Node : in out Node_Type);

----------------    W R I T E _ S H A D O W _ F I L E     ------------
--
--  Purpose:
--  -------
--    Write a shadow file, containing the contents of some of the
--    components of a node handle.
--    If the named shadow file exists, it is replaced; if it does not
--    exist, it is created.
--
--  Parameters:
--  ----------
--    Name  - fully qualified name of the shadow file
--    Node  - Node handle (does NOT have to be open)
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.No_Such_Shadow_File  - if the specified
--        name is empty (i.e. there is no shadow file name).
--
--  Notes:
--  -----
--    None.
--
---------------------------------------------------------------------
        procedure Write_Shadow_File(Node : Node_Type);

----------------------  G E T _ P A R S E D _ P N  ------------------
--
--  Purpose:
--  -------
--    Given a name string, this procedure will "parse"it into the
--    consituent CAIS pathname components.
--
--  Parameters:
--  ----------
--    Name    - the string to be parsed
--    Result  - the fully parsed components.
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.Pathname_Syntax_Error  - if the supplied
--       string is not a syntactically valid pathname.
--    Cais_Internals_Exceptions.Internal_Error  - if the parse stack
--      becomes garbled.
--
--  Notes:
--  -----
--    None.
--
---------------------------------------------------------------------
        procedure Get_Parsed_Pn(Name   : Node_Definitions.Name_String;
                                Result : in out Parsed_Pn);

------------------- P N _ C O M P O N E N T _ C O U N T -------------
--
--  Purpose:
--  -------
--    This function returns the number of distinct pathname components
--    (i.e. pathname elements) in the given parsed pathname.
--
--  Parameters:
--  ----------
--    Pn - the parsed pathname to be examined.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        function Pn_Component_Count(Pn : Parsed_Pn) return Natural;

--------------------  G E T _ P N _ C O M P O N E N T ---------------
--
--  Purpose:
--  -------
--    This procedure extracts the data associated with a specific
--    pathname component (i.e. pathname element).
--
--  Parameters:
--  ----------
--    Pn         - parsed pathname to be examined
--    Index      - offset of path element to be examined
--    Rel_Name   - Relation name of this path element
--    Rel_Key    - Relationship Key of this path element
--    Latest_Rel - boolean indicating if the relationship key
--                 ends with the latest key character (#)
--
--  Exceptions:
--  ----------
--    No_Such_Component - raised if "Index" does not refer to
--                        an existing component in the pathname.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        procedure Get_Pn_Component(Pn         : Parsed_Pn;
                                   Index      : Positive;
                                   Rel_Name   : in out String;
                                   Rel_Key    : in out String;
                                   Latest_Rel : in out Boolean);

    end Node_Internals;


----------------------------------------------------------------------
--                   C A I S _ U T I L I T I E S
--
--  Purpose:
--  -------
--    This package serves to collect together various simple utilities
--    used in the CAIS prototype.  None of the utilities use "internals"
--    knowledge, i.e. all the interfaces that are used by these routines
--    are either in the externally visible MIL-STD-CAIS specification or
--    are in standard libraries.
--
--  Usage:
--  -----
--
--  Example:
--  -------
--    The procedure String_To_Simple_List and Simple_List_To_String
--    are useful for avoiding the error-prone manipulation of String
--    Items in List_Utilities (and working with the leading and trailing
--    embedded "s).
--
--  Notes:
--  -----
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------

    package Cais_Utilities is

        use List_Utilities;
        use Node_Definitions;

        type Predefined_Kind is (Attribute, Relation);

        function Predefined(Name : String;
                            Kind : Predefined_Kind) return Boolean;


----------------------  C H E C K _ I N T E N T I O N S ------------------
--
--  Purpose:
--  -------
--    This procedure checks that a Node has been opened with an
--    intent that explicitly or implicitly grants the priveledges of
--    Intent specified as a parameter.
--
--  Parameters:
--  ----------
--    Node      is the Node to be accessed
--    Intent    is the stated intention for accessing the node
--
--  Exceptions:
--  ----------
--    Node_Definitions.INTENT_VIOLATION  - if the specified intent
--        is not explicitly or implicitly granted by the current
--        Intention of the Node
--    Node_Definitions.USE_ERROR        - if Node is not an open node handle
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
        procedure Check_Intentions(Node     : in Node_Type;
                                   Intended : in Intent_Specification);

----------------------  C H E C K _ I N T E N T I O N S ------------------
--
--  Purpose:
--  -------
--    This procedure checks that a Node has been opened with an
--    intent that explicitly or implicitly grants the priveledges of
--    Intent specified as a parameter.
--
--  Parameters:
--  ----------
--    Node      is the Node to be accessed
--    Intent    is the stated intention for accessing the node
--
--  Exceptions:
--  ----------
--    Node_Definitions.INTENT_VIOLATION  - if the specified intent
--        is not explicitly or implicitly granted by the current
--        Intention of the Node
--    Node_Definitions.USE_ERROR        - if Node is not an open node handle
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------

        procedure Check_Intentions(Intent   : in Intention;
                                   Intended : in Intent_Specification);

        procedure Check_Intentions(Intent   : in Intention;
                                   Intended : in Intention);

        procedure String_To_Simple_List(Str  : String;
                                        List : in out List_Type);

        procedure Simple_List_To_String(List : List_Type;
                                        Str  : in out String);

    function Valid_Relation_Name (Name : String) return Boolean;

    function Valid_Relation_Key (Name : String) return Boolean;

----------------------      Copy      ----------------------
--
--  Purpose:
--  -------
--    This procedure copies to host (Ada) files byte by byte.
--
--  Parameters:
--  ----------
--    From_File    string identifying the file to be copied
--    To_File     string identifying the file to be written
--
--  Exceptions:
--  ----------
--    I/O errors other than End_Error are propogated.
--  Notes:
--  -----
--    Uses Sequential_Io.
--
---------------------------------------------------------------------

        procedure Copy(From_File : in String;
                       To_File   : in String);

    end Cais_Utilities;


----------------------------------------------------------------------
--                  C A I S _ H O S T _ D E P E N D E N T
--                         (Package Specification)
--
--         Host specific services used by the CAIS implementation
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--                  Sat Apr 13 13:44:38 EST 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--
--  Purpose:
--  -------
--    This package is used to isolate host dependent services used
--    in the implementation of the CAIS prototype.
--
--  Usage:
--  -----
--    These services are used mostly in Node_Internals subprograms.
--
--  Example:
--  -------
--    TBS
--
--  Notes:
--  -----
--    None.
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------
    package Cais_Host_Dependent is

        Cais_System_Node    : constant String :=
        "/usr/users/howell/cais/.SYSTEM_NODE";

        Cais_Host_Directory : constant String :=
        "/usr/users/howell/cais/shadowdir/";

        Top_User_Node       : constant String := ".TOP_NODE";

        Top_User_Process    : constant String := ".:";

    -- The following routines interface with host services for
    -- terminal I/O control.  Currently, only interfaces to work with
    -- the "controlling terminal" for the program (e.g. std_out, std_in)
    -- are supported.  There are therefore no interfaces to work
    -- with a file type.

        procedure Unbuffered_Io_On;
        procedure Unbuffered_Io_Off;
        procedure Setecho_On;
        procedure Setecho_Off;
        function Get_Char return Character;
        function Echo_Status return Boolean;

-----------------  G E T _ U N I Q U E _ F I L E N A M E -------------
--
--  Purpose:
--  -------
--    This routine is used generate a filename that is unique for the
--    CAIS "Host Directory" (the shadowdir directory).  The
--    name of the shadowdir directory (Cais_Host_Dependent.Cais_Host_Directory)
--    is used as part of a template passed to create_uniq.
--    The filename returned is fully qualified.  The new file is
--    given a file protection mask of 777 (i.e. rwxrwxrwx).
--
--  Parameters:
--  ----------
--    Name   -  name of new file
--    Length - number of significant characters in Name
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.Internal_Error - if create_uniq fails
--
--  Notes:
--  -----
--
---------------------------------------------------------------------

        procedure Get_Unique_Filename(Name   : in out String;
                                      Length : in out Natural);

-------------------     G E T _ U S E R I D       --------------------
--
--  Purpose:
--  -------
--    This routine determines the CAIS userid for the calling process.
--
--  Parameters:
--  ----------
--    None (returns a string representing the userid).
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.Cais_Userid_Undefined  if the current
--       process (user) does not have a CAIS userid defined.
--
--  Notes:
--  -----
--    In this Unix implementation, the userid is defined by setting
--    an environment variable.
--    For example, in the user's .login, a "setenv CAIS_USERID howell"
--    for the particular user.
--
---------------------------------------------------------------------
        function Get_Userid return String;

---- C U R R E N T _ P R O C E S S _ S H A D O W _ F I L E ----------
--
--  Purpose:
--  -------
--    Returns the fully qualified name of the shadow file that
--    contains information about the current process.
--
--  Parameters:
--  ----------
--    None.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    This first cut is a "quick and dirty" version that deferrs any
--    intelligent handling of multiple processes or even multiple
--    users logged in under the same id.
--
---------------------------------------------------------------------
        function Current_Process_Shadow_File return String;

-----------------  G E T _ U S E R _ P R E F I X  -------------------
--
--  Purpose:
--  -------
--    Given a particular CAIS user id, this subprogram returns the
--    fully qualified host filename for the "user prefix"; this is
--    the prefix to be added to all references to host files (shadow
--    files) specific to that user.
--
--  Parameters:
--  ----------
--    Userid   - string that is the specified CAIS user.
--
--  Exceptions:
--  ----------
--     Cais_Internals_Exceptions.No_Such_User - if the specified
--         user is not in the system node.
--
--  Notes:
--  -----
--    None.
--
---------------------------------------------------------------------
        function Get_User_Prefix(Userid : String) return String;

----------------------  F I L E _ E X I S T S  ----------------------
--
--  Purpose:
--  -------
--    This routine determines if a given string refers to an accessable
--    host file.
--
--  Parameters:
--  ----------
--    Name  - the string representing the host file name.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------
        function File_Exists(Name : String) return Boolean;

    private

        pragma Interface(C, Setecho_Off);
        pragma Interface(C, Setecho_On);

    end Cais_Host_Dependent;

----------------------------------------------------------------------
--        I T E R A T O R _ S U P P O R T
--
--  Purpose:
--  --------
--    This   package  provides  routines  which  support  pattern  matching
--    (including * and ? wild card characters)  and the  creation of sorted
--    lists.  These  capabilities are  required  for the  implementation of
--    Node and Attribute Iterators.  The iterator is  implemented as a list
--    of the format defined by the  package  list_utilities (MIL-STD CAIS
--    section  5.4).
--
--  Usage:
--  -----
--    Patterns are represented by character strings, which must conform  to
--    the rules for Ada identifiers except that wildcard characters  may be
--    included.  A routine is provided to validate patterns to these rules.
--    Another routine matches a token against a  pattern and another  finds
--    the lexicographic position within an already sorted list at which  to
--    insert a token.
--
--  Example:
--  -------
--    Verify_Pattern("*_body?");            --valid pattern
--    Verify_Pattern("*__spec");            --use_error __
--    Verify_Pattern("*.body?");            --use_error . no good
--                --checks attribute against pattern and if
--                --it matches saves it in alphabetized list
--    if Pattern_Match(Attribute,"T???") then
--        Insert(Found, Attribute, Lexical_Position(Found, Attribute));
--    end if;
--
--  Notes:
--  -----
--    This is a version of the package CAIS_ATTRIBUTES,  specified  in
--    MIL-STD-CAIS section 5.1.3; all references to the CAIS specification
--    refer to the MIL-STD-CAIS specification dated 31 January 1985.
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------
    package Iterator_Support is

        use List_Utilities;

----------------------   Lexical_Position     ---------------------------
--
--  Purpose: This function searches an alphebetized list returning the
--  -------  position at which the new named item should be inserted
--
--  Parameters:
--  ----------
--    List    is the named list being searched (names are assumed to be sorted)
--    Name    is the name of the new item to be inserted
--    returns Pos where the named item should be inserted
--
--  Exceptions:
--  ----------
--   None
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
        function Lexical_Position(List : in List_Type;
                                  Name : in Token_Type) return Count;



----------------------   Verify_Pattern   --------------------------------
--
--  Purpose: This procedure checks that a Pattern string conforms to the
--  -------  syntax for identifiers with the addition of wildcard characters
--           '?' and '*'.  It also allows trailing blanks and returns the
--           length of the pattern minus any trailing blanks.
--
--  Parameters:
--  ----------
--    Pattern      is the pattern string to be checked for conformance
--    Size       is returned with the length of Pattern less trailing ' 's
--
--  Exceptions:
--  ----------
--   Use_Error       is raised if the pattern fails conformance
--
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
        procedure Verify_Pattern(Pattern : in String;
                                 Size    : in out Integer);



----------------------   Pattern_Match   ---------------------------
--
--  Purpose: returns true if Canditate string conforms to the pattern
--  -------  which may contain ?s (any character) or *s (any string).
--
--  Parameters:
--  ----------
--    Candidate is a character string to be checked for conformance
--    Pattern   is a character string which defines conformance rules
--
--  Exceptions: None
--  ----------
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
        function Pattern_Match(Candidate : in String;
                                        --string to be checked
                               Pattern   : in String)
                                        --acceptance criteria
        return Boolean;

    end Iterator_Support;



--    Implementation support packages

    package body Node_Representation is separate;
    package body Node_Internals is separate;
    package body Cais_Utilities is separate;
    package body Cais_Host_Dependent is separate;
    package body Iterator_Support is separate;

--    CAIS packages
    package body Node_Management is separate;

    package body Attributes is separate;

    package body Access_Control is separate;

    package body Structural_Nodes is separate;

    package body Process_Control is separate;

    package body Io_Definitions is separate;

    package body Direct_Io_Definitions is separate;

    package body Sequential_Io_Definitions is separate;

    package body Direct_Io is separate;

    package body Sequential_Io is separate;

    package body Text_Io is separate;

    package body Io_Control is separate;

    package body Scroll_Terminal is separate;

    package body Page_Terminal is separate;

    package body Form_Terminal is separate;

    package body Magnetic_Tape is separate;

    package body File_Import_Export is separate;

    package body List_Utilities is separate;

-- not in CAIS specification

    procedure Add_User is separate;
    procedure Delete_User is separate;

begin

    --elaboration time preset
    List_Utilities.To_List("(" & "Access" & "=> N" & "," & "Adopted_Role" &
        "=> N" & "," & "Allow_Access" & "=> N" & "," & "Couple" & "=> N" & ","
        & "Current_Error" & "=> N" & "," & "Current_Input" & "=> N" & "," &
        "Current_Job" & "=> N" & "," & "Current_Node" & "=> N" & "," &
        "Current_Output" & "=> N" & "," & "Current_User" & "=> N" & "," &
        "Device" & "=> N" & "," &
                            --  "Dot"             & "=> N"    & "," &
    "Job" & "=> N" & "," & "Parent" & "=> N" & "," & "Permanent_Member" & "=> N"
        & "," & "Potential_Member" & "=> N" & "," & "Standard_Error" & "=> N"
        & "," & "Standard_Input" & "=> N" & "," & "Standard_Output" & "=> N" &
        "," & "User" & "=> N" & ")", Predefined_Relations);


    --elaboration time preset
    List_Utilities.To_List("(" & "Access_Method" & "=> N" & "," &
        "Current_Status" & "=> N" & "," & "File_Kind" & "=> N" & "," &
        "Finish_Time" & "=> N" & "," & "Grant" & "=> N" & "," & "Handles" &
        "=> N" & "," & "Highest_Classification" & "=> N" & "," & "Io_Units" &
        "=> N" & "," & "Kind" & "=> N" & "," & "Lowest_Classification" & "=> N"
        & "," & "Machine_Time" & "=> N" & "," & "Object_Classification" &
        "=> N" & "," & "Parameters" & "=> N" & "," & "Queue_Kind" & "=> N" & ","
        & "Results" & "=> N" & "," & "Start_Time" & "=> N" & "," &
        "Subject_Classification" & "=> N" & "," & "Terminal_Kind" & "=> N" & ")"
        , Predefined_Attributes);

end Cais;
--::::::::::::::
--cais_direct_io_body.a
--::::::::::::::



----------------------------------------------------------------------
--                   Package  D I R E C T _ I O
--            (Package Body)
--
--            CAIS Direct_Io Access Method
--           Operations for File Node Input/Output
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--            Wed Oct  9 14:37:11 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--                  C A I S _ D I R E C T _ I O
--
--  Purpose:
--  -------
--        This package provides facilities for direct-access input
--        and output to CAIS file comparable to those described
--        in the DIRECT_IO package of the Ada LRM.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Direct_Io
--        package.  The package is instantiated with the element
--        type of the file as parameter.  CAIS file nodes
--        correspond to ordinary Ada files, and file handles are
--        Ada objects of CAIS subtype Direct_Io.File_Type,
--        corresponding to the Ada (LRM) Direct_Io.File_Type.
--        CAIS Direct_Io input and output operations
--        access the contents of CAIS file nodes.
--
--  Notes:
--  -----
--        This is a version of the package CAIS.DIRECT_IO,
--        specified in MIL-STD-CAIS section 5.3.2; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.  This implementation deviates
--        from the CAIS specification in that a distinct type,
--        File_Type is employed in the package, following the
--        Ada LRM.  The package instantiates another generic
--        package, direct_io_definitions, that supports the
--        abstract data type, File_Type.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

with Direct_Io;
with Unchecked_Conversion;

separate(Cais)
package body Direct_Io is

    use Node_Definitions;
    use Node_Representation;
    use Node_Management;
    use Node_Internals;
    use Cais_Utilities;
    use List_Utilities;
    use Dir_Io_Definitions;
    use Identifier_Items;
    use Trace;

                                        -- Local instantiation to provide
                                        --   access to Direct_Io operations
                                        --   using unchecked conversion from
                                        --   corresponding definition of
                                        --   pointer to Ada File_Type in private
                                        --   part of Direct_Io_Definitions
    package Dir_Io is
        new Standard.Direct_Io(Element_Type);
    type File_Ptr is access Dir_Io.File_Type;
    function Convert is
        new Unchecked_Conversion(Direct_File_Ptr, File_Ptr);

    type Mode_Array is array(Positive range <>) of File_Mode;

  ----------------------------   Check_Open   -----------------------------
  --
  --    Local procedure which checks that file handle has required open status
  --
  ---------------------------------------------------------------------------

    procedure Check_Open(File            : File_Type;
                         Required_Result : Boolean) is
    begin
        if Is_Open(File) /= Required_Result then
            raise Dir_Io_Definitions.Status_Error;
        end if;
    end Check_Open;

  ----------------------------   Check_Open   -----------------------------
  --
  --    Local procedure which checks that node handle has required open status
  --
  ---------------------------------------------------------------------------

    procedure Check_Open(Node            : Cais.Node_Type;
                         Required_Result : Boolean) is
    begin
        if Is_Open(Node) /= Required_Result then
            raise Node_Definitions.Status_Error;
        end if;
    end Check_Open;

---------------------------    Check_Not_Mode    --------------------------------
--
--    Local procedure which checks that mode is not in array of
--    excluded modes
--
-------------------------------------------------------------------------------

    procedure Check_Not_Mode(File      : File_Type;
                             Bad_Modes : Mode_Array) is
    begin
        for I in Bad_Modes'range loop
            if Bad_Modes(I) = Mode(File) then
                raise Mode_Error;
            end if;
        end loop;
    end Check_Not_Mode;

---------------------------- Validate_Mode -----------------------------------
--
--    Local procedure which checks that Mode and intent of file_node
--    specified by File are consistent, and determines corresponding
--    Text_Io File_Mode.
--
-------------------------------------------------------------------------------

    procedure Validate_Mode(File       : File_Type;
                            Mode       : File_Mode;
                            Directmode : in out Dir_Io.File_Mode) is
        Intent   : Intention(Pragmatics.Intent_Count);
        Intended : Intention(1 .. 2);
    begin
                                                        --Determine mode and
                                                        --check intentions
        Get_Intent(File, Intent);
        case Mode is
            when In_File =>
                Directmode := Dir_Io.In_File;
                Check_Intentions(Intent, Read_Contents);
            when Out_File =>
                Directmode := Dir_Io.Out_File;
                Check_Intentions(Intent, Write_Contents);
            when Inout_File =>
                Directmode := Dir_Io.Inout_File;
                Check_Intentions(Intent, (1 => Read_Contents, 2 =>
                    Write_Contents));
        end case;

    end Validate_Mode;

----------------------     Create     ----------------------
--
--  Purpose:
--  -------
--        This procedure creates a file and its file node; the
--        file contains elements which may be accessed either
--        directly or sequentially.  The attribute Access_Method is
--        assigned the value "(Direct,Sequential)" as part of the creation.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Base    open node handle to the node which will be the
--        source of the primary relationship to the new
--        node.
--    Key    relationship key of the primary relationship to
--        be created.
--    Relation    relation name of the primary relationship to be created.
--    Mode    indicates mode of the file.
--    Form    indicates file characteristics.
--    Attributes
--        initial values for attributes of the new node.
--    Access_Control
--        defines the initial access control information
--        associated with the created node.
--    Level    defines the classification label for the created node.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if a node already exists for the node specified
--        by Key and Relation or if Key or Relation is syntactically
--        illegal or if any node identifying a group specified in the
--        given Access_Control parameter is unobtainable.
--    Use_Error
--        raised if any of the parameters Access_Control, Level or
--        Attributes is syntactically or semantically illegal.
--        Use_Error is also raised if Relation is the name of a
--        predefined attribute other than File_Kind.  Also raised if
--        Relation is the name of a predefined relation which cannnot
--        be created by the user.
--    Status_Error
--        raised if Base is not an open node handle or if File is
--        an open file handle prior to the call.
--    Intent_Violation
--        raised if Base was not opened with an intent establishing
--        the right to append relationships.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.2.2 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Create that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

    procedure Create(File           : in out File_Type;
                     Base           : in out Node_Type;
                     Key            : Relationship_Key := Latest_Key;
                     Relation       : Relation_Name := Default_Relation;
                     Mode           : File_Mode := Inout_File;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type := Empty_List;
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is


        Node                   : Node_Type;
                                        --Node to be created and associated
                                        --with this File
        Kind                   : constant Node_Kind := Node_Definitions.File;
        Intent                 : Intention(1 .. 2);
        Direct_File_Mode       : File_Mode;
        Form_String            : String(1 .. 100);

        User_Attributes        : List_Type;
        Predefined_Attributes  : List_Type;
        Predefined_Relations   : List_Type;

        New_Contents_File_Name : String(1 .. Pragmatics.Max_Contents_File_Length
            );
        File_Name_Length       : Natural;
        Last                   : Natural;

  ---------------------------  Establish_Intent  ------------------------------
  --
  --    Local procedure which converts Mode parameter to Intent vector
  --    for node handle of new file node.
  --
  -----------------------------------------------------------------------------

        procedure Establish_Intent is
        begin
            case Mode is
                when In_File =>
                    Intent := (1 => Read_Contents, 2 => Existence);
                when Out_File =>
                    Intent := (1 => Write_Contents, 2 => Existence);
                when Inout_File =>
                    Intent := (1 => Read_Contents, 2 => Write_Contents);
            end case;
        end Establish_Intent;

  -------------------------- Filter_Relationships ----------------------------
  --
  --    Local procedure which screens initial values for predefined
  --    relationships of new file node.
  --    (Note:  this procedure is stubbed.)
  --
  ----------------------------------------------------------------------------

        procedure Filter_Relationships is
        begin
            Copy(Predefined_Relations, Empty_List);
        end Filter_Relationships;


  -------------------------- Filter_Attributes -------------------------------
  --
  --    Local procedure which screens initial values for predefined
  --    attributes of new file node.
  --    Attributes are divided into two lists, one for user attributes
  --    and one for predefined attributes.
  --
  ----------------------------------------------------------------------------

        procedure Filter_Attributes is

            Attribute             : List_Type;
            Name                  : Token_Type;
            List_Value            : List_Type;

            File_Kind             : Token_Type;
            File_Kind_Present     : Boolean := False;
            File_Kind_Value       : List_Type;
            Secondary_Storage     : List_Type;

            Access_Method         : Token_Type;
            Access_Method_Present : Boolean := False;
            Access_Method_Value   : List_Type;
            Direct                : Token_Type;
            Sequential            : Token_Type;

            Position              : Position_Count;
            Value_Kind            : Item_Kind;

            Result_List           : List_Type;


        --------------------------  Check_And_Set  ------------------------
        --
        --    Local procedure which checks and sets a Boolean variable used
        --    for recording predefined attributes seen.
        --
        ----------------------------------------------------------------------

            procedure Check_And_Set(Attribute_Present : in out Boolean) is
            begin
                if Attribute_Present then
                    Trace.Report(
                        "CAIS Use_Error: Duplicate attribute in Cais.Direct_Io.Create"
                        );
                    raise Node_Definitions.Use_Error;
                else
                    Attribute_Present := True;
                end if;
            end Check_And_Set;


        -------------------------  Check_Syntax  ------------------------
        --
        --    Local procedure used for checking that list elements have
        --    the required item kind.
        --
        -----------------------------------------------------------------

            procedure Check_Syntax(Value_Kind    : Item_Kind;
                                   Required_Kind : Item_Kind) is
            begin
                if Value_Kind /= Required_Kind then
                    Trace.Report(
                        "CAIS Use_Error: Bad attribute value in Cais.Direct_Io.Create"
                        );
                    raise Dir_Io_Definitions.Use_Error;
                end if;
            end Check_Syntax;
------------------------------------------------------------------------------

        begin

        -- Validate and filter predefined attributes
        --  into a list of initial values for predefined
        --  attributes, and a list of attributes which are
        --  user attributes to be created.
            Copy(User_Attributes, Empty_List);
            Copy(Predefined_Attributes, Empty_List);
            To_Token("File_Kind", File_Kind);
            To_List("(Secondary_Storage)", Secondary_Storage);
            To_Token("Access_Method", Access_Method);
            To_Token("Direct", Direct);
            To_Token("Sequential", Sequential);
                                        -- Set defaults
            To_List("(Secondary_Storage)", File_Kind_Value);
            To_List("(Direct,Sequential)", Access_Method_Value);

                                        -- Filter attribute list
            if Get_List_Kind(Attributes) = Unnamed then
                raise Dir_Io_Definitions.Use_Error;
            end if;

            for I in 1 .. Length(Attributes) loop

                                                -- extract and check attributes
                Value_Kind := Get_Item_Kind(Attributes, I);
                Check_Syntax(Value_Kind, List_Item);
                Item_Name(Attributes, I, Name);
                if Predefined(To_Text(Name), Cais_Utilities.Attribute) then
                                                -- check for File_Kind
                    if Is_Equal(Name, File_Kind) then
                        Check_And_Set(File_Kind_Present);
                        Extract(Attributes, File_Kind, File_Kind_Value);
                        if not Is_Equal(File_Kind_Value, Secondary_Storage)
                            then               -- copy value
                            Trace.Report(
                                "CAIS Use_Error: Invalid File_Kind in Cais.Direct_Io.Create"
                                );
                            raise Dir_Io_Definitions.Use_Error;
                        end if;


                                                -- check for Access_Method
                    elsif Is_Equal(Name, Access_Method) then
                        Check_And_Set(Access_Method_Present);
                        Extract(Attributes, Access_Method, List_Value);

                        begin   -- DIRECT, SEQUENTIAL must be included
                            Position := Position_By_Value(List_Value, Direct);
                            Position := Position_By_Value(List_Value, Sequential
                                );
                            Copy(Access_Method_Value, List_Value);
                        exception
                            when Search_Error =>
                                Trace.Report(
                                    "CAIS Use_Error: Invalid Access_Method in Cais.Direct_Io.Create"
                                    );
                                raise Dir_Io_Definitions.Use_Error;
                            when others =>
                                raise;
                        end;


                    else
                        Trace.Report(
                            "CAIS Use_Error: Invalid predefined attribute in Cais.Direct_Io.Create"
                            );
                        raise Dir_Io_Definitions.Use_Error;
                    end if;

                else            -- others must be user attributes
                    Extract(Attributes, Name, List_Value);
                    Insert(User_Attributes, List_Value, Name, 0);
                end if;
            end loop;

                                        -- Attribute filter completed
                                        -- Construct predefined attribute list

                                        -- Initial value for Access_Method attr
            Insert(Predefined_Attributes, Access_Method_Value, Access_Method, 0)
                ;

            Insert(Predefined_Attributes, File_Kind_Value, File_Kind, 0);

        end Filter_Attributes;


  -----------------------  Establish_Contents_File  ---------------------------
  --
  --    Local procedure used to obtain a uniquely-named contents file
  --    for the new file node, and record its name in the node handle.
  --
  -----------------------------------------------------------------------------

        procedure Establish_Contents_File is
        begin
            Cais_Host_Dependent.Get_Unique_Filename(New_Contents_File_Name,
                File_Name_Length);
            Set_Contents_File_Name(Node, New_Contents_File_Name(1 ..
                File_Name_Length));

        end Establish_Contents_File;

    begin-- Cais.Direct_Io.Create

        Check_Open(Base, True);
                              -- check that node handle is open
                                -- (Node_Definitions.Status_Error)
        Check_Open(File, False);
                               -- check that file handle is not open
                                -- (Dir_Io_Definitions.Status_Error)
        Establish_Intent;
        Filter_Relationships;
        Filter_Attributes;
        Establish_Contents_File;
        Initialize(File);

        -- Actually create the new file node
        --   (establishes its shadow file, checks status, sets attributes,
        --    opens file node)
        Node_Internals.Create_Node(Node => Node, Base => Base, Kind => Kind,
            Internals_Attributes => Predefined_Attributes, User_Attributes =>
            User_Attributes, Internals_Relations => Predefined_Relations, Intent
            => Intent, Access_Control => Access_Control, Level => Level, Key
            => Key, Relation => Relation);

        -- Open the file handle
        Open(File, Node, Mode);

    exception
    -- exceptions that are trapped (nothing propagated)

    -- exceptions that are propagated
        when Dir_Io_Definitions.Name_Error | Dir_Io_Definitions.Use_Error |
            Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Device_Error |
            Node_Definitions.Intent_Violation | Node_Definitions.
            Security_Violation =>
            raise;

    -- exceptions that are mapped to other exceptions

        when Node_Definitions.Name_Error =>
            raise Dir_Io_Definitions.Name_Error;
        when Node_Definitions.Use_Error =>
            raise Dir_Io_Definitions.Use_Error;
        when Node_Definitions.Status_Error =>
            raise Dir_Io_Definitions.Status_Error;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Create ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Create ");
            raise Trace.Assertion_Violation;

    end Create;
-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------


    procedure Create(File           : in out File_Type;
                     Name           : Name_String;
                     Mode           : File_Mode := Inout_File;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type := Empty_List;
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is
        Base : Node_Type;
    begin
        Open(Base, Base_Path(Name), (1 => Append_Relationships));
        Create(File, Base, Last_Key(Name), Last_Relation(Name), Mode, Form,
            Attributes, Access_Control, Level);
        Close(Base);
    exception
        when others =>
            Close(File);
            Close(Base);
            raise;
    end Create;
----------------------     Open     ----------------------
--
--  Purpose:
--  -------
--    This procedure opens a file handle on a file containing
--    elements of the generic parameter type, given an open node
--    handle on the file node.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Node    open node handle to the file node.
--    Mode    indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    Use_Error
--        raised if the attribute Access_Method of the file node
--        does not have the value Direct, the element type of the
--        file does not correspond with the element type of this
--        instantiation of the CAIS Direct_Io package, or the Mode
--        is Append_File.
--
--    Status_Error
--        raised if File is an open file handle at the time of the call
--        or if Node is not an open node handle.
--
--    Intent_Violation
--        raised if Node has not been opened with an intent
--        establishing the access rights required for the Mode.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.2.3 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Open that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

    procedure Open(File : in out File_Type;
                   Node : Node_Type;
                   Mode : File_Mode) is
        File_Name           : Name_String(1 .. Pragmatics.Max_Name_String);
        Directmode          : Dir_Io.File_Mode := Dir_Io.In_File;
        Last_File_Char      : Natural;
        Last_Path_Char      : Natural;

        Pathname            : Name_String(1 .. Pragmatics.Max_Name_String);
        Position            : Position_Count;
        Attribute_List      : List_Type;

        Access_Method       : Token_Type;
        Access_Method_Value : List_Type;
        Direct              : Token_Type;

        File_Kind           : Token_Type;
        File_Kind_Value     : List_Type;
        Secondary_Storage   : List_Type;


    begin

        Check_Open(Node, True);
                              -- check that node handle is open
                                -- (Node_Definitions.Status_Error)
        Check_Open(File, False);
                               -- check that file handle is not open
                                -- (Dir_Io_Definitions.Status_Error)

                                -- Check that node is file node
        if Get_Kind(Node) /= Node_Definitions.File then
            raise Node_Definitions.Use_Error;
        end if;

        Initialize(File);
        Set_Intent(File, Get_Intent(Node));                     --Set intentions
        Get_Shadow_File_Name(Node, File_Name, Last_File_Char);
                                                        --Set Shadow file
        Set_Shadow_File_Name(File, File_Name(1 .. Last_File_Char));
        Get_Contents_File_Name(Node, File_Name, Last_File_Char);
                                                        --Set contents file
        Set_Contents_File_Name(File, File_Name(1 .. Last_File_Char));
        Get_Pathname(Node, Pathname, Last_Path_Char);           --Set file node name
        Set_Name(File, Pathname(1 .. Last_Path_Char));

                                                        --Check Use errors
        Validate_Mode(File, Mode, Directmode);  --checks mode against intent

        Get_Node_Attributes(Node, Attribute_List);
        To_Token("Access_Method", Access_Method);
        To_Token("Direct", Direct);
        begin                   -- Check Access_Method includes Direct
            Extract(Attribute_List, Access_Method, Access_Method_Value);
            Position := Position_By_Value(Access_Method_Value, Direct);

        exception
            when List_Utilities.Search_Error =>
                Trace.Report(
                    "CAIS Use_Error: Invalid Access_Method in Cais.Direct_Io.Open "
                    );
                Trace.Report("Access_Method: " & To_Text(Access_Method_Value));
                Trace.Report("Expected list containing: (Direct,Sequential)");
                raise Dir_Io_Definitions.Use_Error;

        end;

        To_Token("File_Kind", File_Kind);
        To_List("(Secondary_Storage)", Secondary_Storage);
        Extract(Attribute_List, File_Kind, File_Kind_Value);
        if not Is_Equal(File_Kind_Value, Secondary_Storage) then
            Trace.Report(
                "CAIS Use_Error: Invalid File_Kind in Cais.Direct_Io.Open ");
            Trace.Report("Access_Method: " & To_Text(File_Kind_Value));
            Trace.Report("Expected: Secondary_Storage");
            raise Dir_Io_Definitions.Use_Error;
        end if;


        Set_Mode(File, Mode);                   --Set Mode

        Dir_Io.Open(Convert(Get_File_Type(File)).all, Directmode, File_Name(1
            .. Last_File_Char));                       --Open file

    exception

    -- exceptions that are propagated
        when Dir_Io_Definitions.Use_Error | Dir_Io_Definitions.Status_Error |
            Dir_Io_Definitions.Device_Error | Node_Definitions.Intent_Violation
            =>
            raise;


    -- exceptions that are mapped to other exceptions
    -- Search_Error looking for Direct in Access_Method list is
    --    mapped to Use_Error.
        when Node_Definitions.Use_Error =>
            raise Dir_Io_Definitions.Use_Error;
        when Node_Definitions.Status_Error =>
            raise Dir_Io_Definitions.Status_Error;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Open ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Open ");
            raise Trace.Assertion_Violation;

    end Open;

-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

    procedure Open(File : in out File_Type;
                   Name : Name_String;
                   Mode : File_Mode) is
        Node : Node_Type;
    begin
        case Mode is
            when In_File =>
                Open(Node, Name, (1 => Read_Contents));
            when Out_File =>
                Open(Node, Name, (1 => Write_Contents));
            when Inout_File =>
                Open(Node, Name, (Read_Contents, Write_Contents));
        end case;

        Open(File, Node, Mode);
        Close(Node);
    exception
        when others =>
            Close(File);
            Close(Node);
            raise;
    end Open;


----------------------     Close     ----------------------
--
--  Purpose:
--  -------
--    Closes file handle to CAIS file node.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------


    procedure Close(File : in out File_Type) is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        Dir_Io.Close(Convert(Get_File_Type(File)).all); -- Close contents file
        Deallocate(File);                       -- Deallocate file handle

    exception
      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Device_Error
            =>
            raise;

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Close ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Close ");
            raise Trace.Assertion_Violation;

    end Close;



----------------------     Delete     ----------------------
--
--  Purpose:
--  -------
--    This procedure deletes the CAIS file identified
--    by File.
--    In addition to the semantics specified in the LRM,
--    the node associated with the open file handle File
--    is made unobtainable as if a call to the Delete_Node
--    procedure had been made.
--
--  Parameters:
--  ----------
--    File    an open file handle on the file being deleted.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if the parent node of the node associated with
--        the file identified by File is inaccessible.
--    Use_Error
--        raised if any primary relationships emanate from the
--        node associated with the file identified by File.
--    Status_Error
--        raised if File is not an open file handle.
--    Lock_Error
--        raised if access with intent Write_Relationships to the
--        parent of the node to be deleted cannot be obtained due
--        to an existing lock on the node.
--    Access_Violation
--        raised if the current process does not have sufficient
--        discretionary access control rights to obtain access to
--        the parent of the node to be deleted with intent
--        Exclusive_Write; only raised if the conditions for
--        Name_Error are not present.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.2.4 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Delete(File : in out File_Type) is
        Name : String(1 .. Pragmatics.Max_Name_String);
        Node : Node_Type;
        Last : Natural;
    begin

        Check_Open(File, True);  -- Status_Error if file handle not open
        Get_Name(File, Name, Last);     -- Get file node name
        Close(File);                    -- Close contents file
        Open(Node, Name(1 .. Last),             -- Make file node unobtainable
        (1 => Read_Relationships, 2 => Exclusive_Write));
        Delete_Node(Node);
    exception

    -- exceptions that are propagated
        when Dir_Io_Definitions.Use_Error | Dir_Io_Definitions.Status_Error |
            Dir_Io_Definitions.Device_Error | Node_Definitions.Lock_Error |
            Node_Definitions.Access_Violation | Node_Definitions.
            Security_Violation =>
            raise;


    -- exceptions that are mapped to other exceptions
        when Node_Definitions.Name_Error =>
            raise Dir_Io_Definitions.Name_Error;
        when Node_Definitions.Use_Error =>
            raise Dir_Io_Definitions.Use_Error;
        when Node_Definitions.Status_Error =>
            raise Dir_Io_Definitions.Status_Error;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Delete ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Delete ");
            raise Trace.Assertion_Violation;


    end Delete;


----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset the file mode of a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--    Mode    Indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if the file handle is not open
--    Use_Error
--        raised if the node associated with the file identified
--        by File has a value of Terminal or Magnetic_Tape for
--        the attribute File_Kind and the Mode is Append_File.
--    Intent_Error
--        See note.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The implementation raises Intent_Violation if mode
--    violates the intent with which the file node was opened.
--    These semantics are not stated in the MIL-STD-CAIS, but
--    are required for consistent intent enforcement.
--
---------------------------------------------------------------------

    procedure Reset(File : in out File_Type;
                    Mode : File_Mode) is
        Directmode : Dir_Io.File_Mode := Dir_Io.In_File;
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open

        Validate_Mode(File, Mode, Directmode);          -- Confirm access rights
        Set_Mode(File, Mode);                   -- Record current CAIS mode
                                                -- Reset contents file
        Dir_Io.Reset(Convert(Get_File_Type(File)).all, Directmode);
    exception

    -- exceptions that are propagated
        when Dir_Io_Definitions.Use_Error | Dir_Io_Definitions.Status_Error |
            Dir_Io_Definitions.Device_Error | Node_Definitions.Intent_Violation
            =>
            raise;


      -- exceptions that are mapped to other exceptions

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Reset ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Reset ");
            raise Trace.Assertion_Violation;

    end Reset;


----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if the file handle is not open
--    Use_Error
--        raised if environment does not support resetting for
--        the stored file
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    Semantics of this procedure are not restricted to Ada LRM
--    semantics, pending clarification of the interaction of access
--    methods in the CAIS.
---------------------------------------------------------------------

    procedure Reset(File : in out File_Type) is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        Dir_Io.Reset(Convert(Get_File_Type(File)).all);
    exception
      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Device_Error
            =>
            raise;

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Reset ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Reset ");
            raise Trace.Assertion_Violation;

    end Reset;

----------------------     Mode     ----------------------
--
--  Purpose:
--  -------
--    Returns the current mode of the current CAIS file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Mode(File : File_Type) return File_Mode is
        Mode : File_Mode;
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        Get_Mode(File, Mode);
        return Mode;
    exception
      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Device_Error
            =>
            raise;

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Mode ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Mode ");
            raise Trace.Assertion_Violation;

    end Mode;

----------------------     Name     ----------------------
--
--  Purpose:
--  -------
--    Returns a string containing the name of the CAIS file
--    node currently associated with the file handle.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Name(File : File_Type) return String is
        File_Node_Name : String(1 .. Pragmatics.Max_Name_String);
        Last           : Natural;
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        Get_Name(File, File_Node_Name, Last);
        return File_Node_Name(1 .. Last);
    exception
      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Device_Error
            =>
            raise;

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Name ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Name ");
            raise Trace.Assertion_Violation;

    end Name;

----------------------     Form     ----------------------
--
--  Purpose:
--  -------
--    Returns the form string for the external file currently
--    associated with the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Form(File : File_Type) return String is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        return Dir_Io.Form(Convert(Get_File_Type(File)).all);
    exception
      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Device_Error
            =>
            raise;

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Form ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Form ");
            raise Trace.Assertion_Violation;

    end Form;

----------------------     Is_Open     ----------------------
--
--  Purpose:
--  -------
--    Returns TRUE if the file handle is open, otherwise returns FALSE.
--
--  Parameters:
--  ----------
--    File    file handle.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Is_Open(File : File_Type) return Boolean is
    begin
        return (not Un_Initialized(File)) and then Dir_Io.Is_Open(Convert(
            Get_File_Type(File)).all);
    end Is_Open;


---------------------------     Read     ---------------------------
--
--  Purpose:
--  -------
--    Sets the current index of the given file to the index
--    value given by the parameter From.
--    Returns in the parameter Item, the value of the element
--    whose position in the given file is specified by the
--    current index of the file; then increases the current
--    index by one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    returns element read from file.
--    From    index of element to be read.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if the mode is not In_File.
--    End_Error
--        raised if the index to be used exceeds the size
--        of the given file.
--    Data_Error
--        raised if the element read cannot be interpreted
--        as a value of the generic parameter type.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

    procedure Read(File : File_Type;
                   Item : in out Element_Type;
                   From : Positive_Count) is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        Dir_Io.Read(Convert(Get_File_Type(File)).all, Item, Dir_Io.
            Positive_Count(From));
    exception

      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Mode_Error |
            Dir_Io_Definitions.Device_Error | Dir_Io_Definitions.End_Error |
            Dir_Io_Definitions.Data_Error =>
            raise;


      -- exceptions that are mapped to other exceptions

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Read ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Read ");
            raise Trace.Assertion_Violation;

    end Read;

---------------------------     Read     ---------------------------
--
--  Purpose:
--  -------
--    Returns in the parameter Item, the value of the element
--    whose position in the given file is specified by the
--    current index of the file; then increases the current
--    index by one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    returns element read from file.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if the mode is not In_File.
--    End_Error
--        raised if the index to be used exceeds the size
--        of the given file.
--    Data_Error
--        raised if the element read cannot be interpreted
--        as a value of the generic parameter type.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

    procedure Read(File : File_Type;
                   Item : in out Element_Type) is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        Dir_Io.Read(Convert(Get_File_Type(File)).all, Item);
    exception

      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Mode_Error |
            Dir_Io_Definitions.Device_Error | Dir_Io_Definitions.End_Error |
            Dir_Io_Definitions.Data_Error =>
            raise;


      -- exceptions that are mapped to other exceptions

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Read ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Read ");
            raise Trace.Assertion_Violation;

    end Read;

---------------------------     Write     ---------------------------
--
--  Purpose:
--  -------
--    Sets the index of the given file to the index value given
--    by the parameter To.
--    Gives the value of the parameter Item to the element whose
--    position in the given file is specified by the current index
--    of the file; then increases the current index by one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    element to be written to the file.
--    To    index of element to be written.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if mode is In_File.
--    Use_Error
--        raised if the capacity of the file is exceeded.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

    procedure Write(File : File_Type;
                    Item : Element_Type;
                    To   : Positive_Count) is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        Dir_Io.Write(Convert(Get_File_Type(File)).all, Item, Dir_Io.
            Positive_Count(To));
    exception

      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Use_Error |
            Dir_Io_Definitions.Mode_Error | Dir_Io_Definitions.Device_Error =>
            raise;


      -- exceptions that are mapped to other exceptions

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Write ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Write ");
            raise Trace.Assertion_Violation;

    end Write;

---------------------------     Write     ---------------------------
--
--  Purpose:
--  -------
--    Gives the value of the parameter Item to the element whose
--    position in the given file is specified by the current index
--    of the file; then increases the current index by one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    element to be written to the file.
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if mode is In_File.
--    Use_Error
--        raised if the capacity of the file is exceeded.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

    procedure Write(File : File_Type;
                    Item : Element_Type) is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        Dir_Io.Write(Convert(Get_File_Type(File)).all, Item);
    exception

      -- exceptions that are propagated
        when Dir_Io_Definitions.Use_Error | Dir_Io_Definitions.Status_Error |
            Dir_Io_Definitions.Mode_Error | Dir_Io_Definitions.Device_Error =>
            raise;


      -- exceptions that are mapped to other exceptions

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Write ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Write ");
            raise Trace.Assertion_Violation;

    end Write;


----------------------     Set_Index     ----------------------
--
--  Purpose:
--  -------
--    Sets the current index of the given file to the given
--    index value (which may exceed the current size of the file).
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    index value.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

    procedure Set_Index(File : File_Type;
                        To   : Positive_Count) is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        Dir_Io.Set_Index(Convert(Get_File_Type(File)).all, Dir_Io.Positive_Count
            (To));
    exception
      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Device_Error
            =>
            raise;

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Set_Index ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Set_Index ")
                ;
            raise Trace.Assertion_Violation;

    end Set_Index;



----------------------     Index     ----------------------
--
--  Purpose:
--  -------
--    Returns the current index of the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

    function Index(File : File_Type) return Positive_Count is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        return Positive_Count(Dir_Io.Index(Convert(Get_File_Type(File)).all));
    exception
      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Device_Error
            =>
            raise;

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Index ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Index ");
            raise Trace.Assertion_Violation;

    end Index;


----------------------     Size     ----------------------
--
--  Purpose:
--  -------
--    Returns the current size of the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

    function Size(File : File_Type) return Count is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        return Positive_Count(Dir_Io.Size(Convert(Get_File_Type(File)).all));
    exception
      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Device_Error
            =>
            raise;

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.Size ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Direct_Io.Size ");
            raise Trace.Assertion_Violation;

    end Size;

----------------------     End_Of_File     ----------------------
--
--  Purpose:
--  -------
--    Returns True if the current index is exceeds the size of the
--    given file;  otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if file mode is Out_File.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

    function End_Of_File(File : File_Type) return Boolean is
    begin
        Check_Open(File, True);  -- Status_Error if file handle not open
        return Dir_Io.End_Of_File(Convert(Get_File_Type(File)).all);
    exception
      -- exceptions that are propagated
        when Dir_Io_Definitions.Status_Error | Dir_Io_Definitions.Mode_Error |
            Dir_Io_Definitions.Device_Error =>
            raise;

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Direct_Io.End_Of_File ")
                ;
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report(
                "UNANTICIPATED EXCEPTION in Cais.Direct_Io.End_Of_File ");
            raise Trace.Assertion_Violation;

    end End_Of_File;

------------------------------------------------------------------------
end Direct_Io;
------------------------------------------------------------------------
--::::::::::::::
--cais_generics.a
--::::::::::::::


----------------------------------------------------------------------
--            I N T E G E R _ I O
--     (Separately compiled package body from Cais.Text_Io)
--
--            E N U M E R A T I O N _ I O
--     (Separately compiled package body from Cais.Text_Io)
--
--            F I X E D _ I O
--     (Separately compiled package body from Cais.Text_Io)
--
--            F L O A T _ I O
--     (Separately compiled package body from Cais.Text_Io)
--
--
--            Generic Packages in
--            CAIS Text_Io Access Method
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--            Wed Oct  9 10:55:45 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

----------------------------------------------------------------------
--              C A I S . T E X T _ I O . I N T E G E R _ I O
--
--  Purpose:
--  -------
--        Integer_Io is a generic package nested in the CAIS Text_Io package.
--        This package provides facilities for the input and output
--        of textual integer data to CAIS files.  These facilities are
--        comparable to those specified in the package TEXT_IO.INTEGER_IO
--        in the Ada LRM, Chapter 14.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Text_Io.Integer_Io package.
--        CAIS file nodes correspond to ordinary Ada files.
--        Input and output operations access the contents of CAIS
--        file nodes.
--        The package is instantiated for the element type.  File_Type
--        and File_Mode are subtypes declared in the Cais.Text_Io package.
--
--  Example:
--  -------
--        type Small_Integer is range 1..20;
--        ...
--        File      : File_Type;
--        package Small_Io is new Cais.Text_Io.Integer_Io (Small_Integer);
--        ...
--        Small_Io.Put (File, 15);
--        ...
--
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO.INTEGER_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

with Text_Io;
separate(Cais.Text_Io)
package body Integer_Io is

  --Default_Width  : Field := Num'Width;
  --Default_Base   : Number_Base := 10;

    package Int_Io is
        new Standard.Text_Io.Integer_Io(Num);


----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file, according to the syntax of a literal
--    of the parameter type,
--    and stores the converted value in the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of the generic parameter type.
--    Width    field width, or 0 if unbounded.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Get(File  : File_Type;
                  Item  : in out Num;
                  Width : Field := 0) is
    begin
        Check_Open(File, True); -- Status_Error if file not open
        Int_Io.Get(Get_File_Type(File).all, Item, Width);
    end Get;


    procedure Get(Item  : in out Num;
                  Width : Field := 0) is
    begin
        Get(Current_Input, Item, Width);
    end Get;

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes the value of Item, represented as a literal
--    of the parameter type, to the specified file.
--
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of the generic parameter type.
--    Width    minimum field width.
--    Base    base for literal representation.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.7 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Put(File  : File_Type;
                  Item  : Num;
                  Width : Field := Default_Width;
                  Base  : Number_Base := Default_Base) is
    begin
        Check_Open(File, True); -- Status_Error if file not open
        Int_Io.Put(Get_File_Type(File).all, Item, Width, Base);
    end Put;


    procedure Put(Item  : Num;
                  Width : Field := Default_Width;
                  Base  : Number_Base := Default_Base) is
    begin
        Put(Current_Output, Item, Width, Base);
    end Put;

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    string into the item parameter, following the same
--    rule as for reading from a file, but treating the
--    end of the string as a file terminator.
--
--  Parameters:
--  ----------
--    From    string.
--    Item    out parameter of the generic parameter type.
--    Last    index value of last character read.
--
--  Exceptions:
--  ----------
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.7
--
---------------------------------------------------------------------

    procedure Get(From : String;
                  Item : in out Num;
                  Last : in out Positive) is
    begin
        Int_Io.Get(From, Item, Last);
    end Get;

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified string,
--    following the same rule as for output to a file.
--
--  Parameters:
--  ----------
--    To    string.
--    Item    in parameter of generic parameter type.
--    Base    base for literal representation.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the remaining string length.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.7
--
---------------------------------------------------------------------

    procedure Put(To   : in out String;
                  Item : Num;
                  Base : Number_Base := Default_Base) is
    begin
        Int_Io.Put(To, Item, Base);
    end Put;

end Integer_Io;

----------------------------------------------------------------------
--              C A I S . T E X T _ I O . F L O A T _ I O
--
--  Purpose:
--  -------
--        Float_Io is a generic package nested in the CAIS Text_Io package.
--        This package provides facilities for the input and output
--        of textual float data to CAIS files.  These facilities are
--        comparable to those specified in the package TEXT_IO.FLOAT_IO
--        in the Ada LRM, Chapter 14.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Standard.Text_Io.Float_Io package.
--        CAIS file nodes correspond to ordinary Ada files.
--        Input and output operations access the contents of CAIS
--        file nodes.
--        The package is instantiated for the element type.  File_Type
--        and File_Mode are subtypes declared in the Cais.Text_Io package.
--
--  Example:
--  -------
--        type Real_Float is digits 5 range 0.0000 .. 9.9999;
--        ...
--        File      : File_Type;
--        package Real_Io is new Cais.Text_Io.Float_Io (Real_Float);
--        ...
--        Real_Io.Put (File, 2.3456);
--        ...
--
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO.FLOAT_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

with Text_Io;
separate(Cais.Text_Io)
package body Float_Io is

  --Default_Fore    :  Field := 2;
  --Default_Aft    :  Field := Num'Digits-1;
  --Default_Exp    :  Field := 3;

    package Flt_Io is
        new Standard.Text_Io.Float_Io(Num);


----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file, according to the syntax of a literal
--    of the parameter type,
--    and stores the converted value in the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of the generic parameter type.
--    Width    field width, or 0 if unbounded.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Get(File  : File_Type;
                  Item  : in out Num;
                  Width : Field := 0) is
    begin
        Check_Open(File, True); -- Status_Error if file not open
        Flt_Io.Get(Get_File_Type(File).all, Item, Width);
    end Get;


    procedure Get(Item  : in out Num;
                  Width : Field := 0) is
    begin
        Get(Current_Input, Item, Width);
    end Get;


----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes the value of Item, represented as a literal
--    of the parameter type, to the specified file.
--
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of the generic parameter type.
--    Width    minimum field width.
--    Fore    digits before decimal in literal representation.
--    Aft    digits after decimal in literal representation.
--    Exp    digits in exponent in literal representation.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.7 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Put(File : File_Type;
                  Item : Num;
                  Fore : Field := Default_Fore;
                  Aft  : Field := Default_Aft;
                  Exp  : Field := Default_Exp) is
    begin
        Check_Open(File, True); -- Status_Error if file not open
        Flt_Io.Put(Get_File_Type(File).all, Item, Fore, Aft, Exp);
    end Put;


    procedure Put(Item : Num;
                  Fore : Field := Default_Fore;
                  Aft  : Field := Default_Aft;
                  Exp  : Field := Default_Exp) is
    begin
        Put(Current_Output, Item, Fore, Aft, Exp);
    end Put;

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    string into the item parameter, following the same
--    rule as for reading from a file, but treating the
--    end of the string as a file terminator.
--
--  Parameters:
--  ----------
--    From    string.
--    Item    out parameter of the generic parameter type.
--    Last    index value of last character read.
--
--  Exceptions:
--  ----------
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.7
--
---------------------------------------------------------------------

    procedure Get(From : String;
                  Item : in out Num;
                  Last : in out Positive) is
    begin
        Flt_Io.Get(From, Item, Last);
    end Get;

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified string,
--    following the same rule as for output to a file.
--    The number of digits before the exponent is adjusted so
--    that the literal exactly fills the string.
--
--  Parameters:
--  ----------
--    To    string.
--    Item    in parameter of generic parameter type.
--    Aft    digits after the decimal in the literal representation.
--    Exp    digits in the exponent in the literal representation.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the remaining string length.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.7
--
---------------------------------------------------------------------

    procedure Put(To   : in out String;
                  Item : Num;
                  Aft  : Field := Default_Aft;
                  Exp  : Field := Default_Exp) is
    begin
        Flt_Io.Put(To, Item, Aft, Exp);
    end Put;

end Float_Io;



----------------------------------------------------------------------
--              C A I S . T E X T _ I O . F I X E D _ I O
--
--  Purpose:
--  -------
--        Fixed_Io is a generic package nested in the CAIS Text_Io package.
--        This package provides facilities for the input and output
--        of textual Fixed data to CAIS files.  These facilities are
--        comparable to those specified in the package TEXT_IO.FIXED_IO
--        in the Ada LRM, Chapter 14.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Text_Io.Fixed_Io package.
--        CAIS file nodes correspond to ordinary Ada files.
--        Input and output operations access the contents of CAIS
--        file nodes.
--        The package is instantiated for the element type.  File_Type
--        and File_Mode are subtypes declared in the Cais.Text_Io package.
--
--  Example:
--  -------
--        type Real_Fixed is delta 0.001 range 0.000 .. 9.999;
--        ...
--        File      : File_Type;
--        package Real_Io is new Cais.Text_Io.Fixed_Io (Real_Fixed);
--        ...
--        Real_Io.Put (File, 5.432);
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO.FIXED_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

with Text_Io;
separate(Cais.Text_Io)
package body Fixed_Io is

  --Default_Fore    :  Field := Num'Fore;
  --Default_Aft    :  Field := Num'Aft;
  --Default_Exp    :  Field := 0;

    package Fix_Io is
        new Standard.Text_Io.Fixed_Io(Num);


----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file, according to the syntax of a literal
--    of the parameter type,
--    and stores the converted value in the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of the generic parameter type.
--    Width    field width, or 0 if unbounded.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Get(File  : File_Type;
                  Item  : in out Num;
                  Width : Field := 0) is
    begin
        Check_Open(File, True); -- Status_Error if file not open
        Fix_Io.Get(Get_File_Type(File).all, Item, Width);
    end Get;


    procedure Get(Item  : in out Num;
                  Width : Field := 0) is
    begin
        Get(Current_Input, Item, Width);
    end Get;


----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes the value of Item, represented as a literal
--    of the parameter type, to the specified file.
--
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of the generic parameter type.
--    Width    minimum field width.
--    Fore    digits before decimal in literal representation.
--    Aft    digits after decimal in literal representation.
--    Exp    digits in exponent in literal representation.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.7 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Put(File : File_Type;
                  Item : Num;
                  Fore : Field := Default_Fore;
                  Aft  : Field := Default_Aft;
                  Exp  : Field := Default_Exp) is
    begin
        Check_Open(File, True); -- Status_Error if file not open
        Fix_Io.Put(Get_File_Type(File).all, Item, Fore, Aft, Exp);
    end Put;


    procedure Put(Item : Num;
                  Fore : Field := Default_Fore;
                  Aft  : Field := Default_Aft;
                  Exp  : Field := Default_Exp) is
    begin
        Put(Current_Output, Item, Fore, Aft, Exp);
    end Put;

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    string into the item parameter, following the same
--    rule as for reading from a file, but treating the
--    end of the string as a file terminator.
--
--  Parameters:
--  ----------
--    From    string.
--    Item    out parameter of the generic parameter type.
--    Last    index value of last character read.
--
--  Exceptions:
--  ----------
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.8
--
---------------------------------------------------------------------

    procedure Get(From : String;
                  Item : in out Num;
                  Last : in out Positive) is
    begin
        Fix_Io.Get(From, Item, Last);
    end Get;

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified string,
--    following the same rule as for output to a file.
--    The number of digits before the exponent is adjusted so
--    that the literal exactly fills the string.
--
--  Parameters:
--  ----------
--    To    string.
--    Item    in parameter of generic parameter type.
--    Aft    digits after the decimal in the literal representation.
--    Exp    digits in the exponent in the literal representation.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the remaining string length.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.8
--
---------------------------------------------------------------------

    procedure Put(To   : in out String;
                  Item : Num;
                  Aft  : Field := Default_Aft;
                  Exp  : Field := Default_Exp) is
    begin
        Fix_Io.Put(To, Item, Aft, Exp);
    end Put;

end Fixed_Io;

----------------------------------------------------------------------
--              C A I S . T E X T _ I O . E N U M E R A T I O N _ I O
--
--  Purpose:
--  -------
--        Enumeration_Io is a generic package nested in the CAIS Text_Io package.
--        This package provides facilities for the input and output
--        of textual enumeration data to CAIS files.  These facilities are
--        comparable to those specified in the package TEXT_IO.ENUMERATION_IO
--        in the Ada LRM, Chapter 14.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Text_Io.Enumeration_Io package.
--        CAIS file nodes correspond to ordinary Ada files.
--        Input and output operations access the contents of CAIS
--        file nodes.
--        The package is instantiated for the element type.  File_Type
--        and File_Mode are subtypes declared in the Cais.Text_Io package.
--
--  Example:
--  -------
--        type Color is (Red, Yellow, Blue);
--        package Hue_Io is new Cais.Text_Io.Enumeration_Io (Color);
--        ...
--        File : File_Type;
--        ...
--        Hue_Io.Put (File, Blue);
--        ...
--
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO.ENUMERATION_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

with Text_Io;
separate(Cais.Text_Io)
package body Enumeration_Io is

  --Default_Width    : Field := 0;
  --Default_Setting  : Type_Set := Upper_Case;

    package Enum_Io is
        new Standard.Text_Io.Enumeration_Io(Enum);


----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file, according to the syntax of a literal
--    of the parameter type,
--    and stores the converted value in the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of the generic parameter type.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Get(File : File_Type;
                  Item : in out Enum) is
    begin
        Check_Open(File, True); -- Status_Error if file not open
        Enum_Io.Get(Get_File_Type(File).all, Item);
    end Get;


    procedure Get(Item : in out Enum) is
    begin
        Get(Current_Input, Item);
    end Get;

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes the value of Item, represented as a literal
--    of the parameter type, to the specified file.
--
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of the generic parameter type.
--    Width    minimum field width.
--    Set    character set.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.7 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Put(File  : File_Type;
                  Item  : Enum;
                  Width : Field := Default_Width;
                  Set   : Type_Set := Default_Setting) is
    begin
        Check_Open(File, True); -- Status_Error if file not open
        Enum_Io.Put(Get_File_Type(File).all, Item, Width, Standard.Text_Io.
            Type_Set'Val(Type_Set'Pos(Set)));
    end Put;


    procedure Put(Item  : Enum;
                  Width : Field := Default_Width;
                  Set   : Type_Set := Default_Setting) is
    begin
        Put(Current_Output, Item, Width, Set);
    end Put;

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    string into the item parameter, following the same
--    rule as for reading from a file, but treating the
--    end of the string as a file terminator.
--
--  Parameters:
--  ----------
--    From    string.
--    Item    out parameter of the generic parameter type.
--    Last    index value of last character read.
--
--  Exceptions:
--  ----------
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.9
--
---------------------------------------------------------------------

    procedure Get(From : String;
                  Item : in out Enum;
                  Last : in out Positive) is
    begin
        Enum_Io.Get(From, Item, Last);
    end Get;

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified string,
--    following the same rule as for output to a file.
--    The number of digits before the exponent is adjusted so
--    that the literal exactly fills the string.
--
--  Parameters:
--  ----------
--    To    string.
--    Item    in parameter of generic parameter type.
--    Set    character set.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the remaining string length.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.9
--
---------------------------------------------------------------------

    procedure Put(To   : in out String;
                  Item : Enum;
                  Set  : Type_Set := Default_Setting) is
    begin
        Enum_Io.Put(To, Item, Standard.Text_Io.Type_Set'Val(Type_Set'Pos(Set)))
            ;
    end Put;

end Enumeration_Io;
--::::::::::::::
--cais_host_dependent_body.a
--::::::::::::::

----------------------------------------------------------------------
--                  C A I S _ H O S T _ D E P E N D E N T
--                             (Package Body)
--
--         Host specific services used by the CAIS implementation
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--                  Sat Apr 13 13:44:38 EST 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--
--  Purpose:
--  -------
--    This package is used to isolate host dependent services used
--    in the implementation of the CAIS prototype.
--
--  Usage:
--  -----
--    These services are used mostly in Node_Internals subprograms.
--
--  Example:
--  -------
--    TBS
--
--  Notes:
--  -----
--    None.
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------

with Trace;
with Unchecked_Conversion;
with System;

separate(Cais)
package body Cais_Host_Dependent is

    procedure Cbreak_On;
    procedure Cbreak_Off;
    function Charget return Tiny_Integer;
    function Test_Echo return Integer;
    function cfile_exists (Name : System.Address) return Integer;

    pragma Interface(C, Cbreak_On);
    pragma Interface(C, Cbreak_Off);
    pragma Interface(C, Charget);
    pragma Interface(C, Test_Echo);
    pragma interface (C, cfile_exists);


    -- The C routine "charget" returns a single byte as an integer, so it is
    -- necessary to convert it to a character before returning it.
    function Byte_To_Char is
        new Unchecked_Conversion(Tiny_Integer, Character);


    procedure Unbuffered_Io_On is
    begin
        Cbreak_On;
    end Unbuffered_Io_On;

    procedure Unbuffered_Io_Off is
    begin
        Cbreak_Off;
    end Unbuffered_Io_Off;

    function Get_Char return Character is

        Charint : Tiny_Integer;
    begin
        Cbreak_On;

        Charint := Charget;
        if (Charint =  -1) then
            raise Cais.Io_Definitions.End_Error;
        end if;

        Cbreak_Off;
        return Byte_To_Char(Charint);
    exception
    -- exceptions that are trapped (nothing propagated)
        -- None.
    -- exceptions that are propagated
        when Cais.Io_Definitions.End_Error =>
            raise;
    -- exceptions that are mapped to other exceptions
        -- None.
    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in " &
                "Cais_Host_Dependent.Get_Char");
            raise;
    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in " &
                "Cais_Host_Dependent.Get_Char");
            raise Trace.Assertion_Violation;
    end Get_Char;

    function Echo_Status return Boolean is
        Result : Integer;
    begin
        Result := Test_Echo;
        if Result =  -1 then
            raise Cais.Io_Definitions.Device_Error;
        else
            return (Result = 1);
        end if;
    end Echo_Status;

    procedure Get_Unique_Filename(Name   : in out String;
                                  Length : in out Natural) is separate;


    function Get_Userid return String is separate;


---- C U R R E N T _ P R O C E S S _ S H A D O W _ F I L E ----------
--
--  Purpose:
--  -------
--    Returns the fully qualified name of the shadow file that
--    contains information about the current process.
--
--  Parameters:
--  ----------
--    None.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    This first cut is a "quick and dirty" version that deferrs any
--    intelligent handling of multiple processes or even multiple
--    users logged in under the same id.
--
---------------------------------------------------------------------

    function Current_Process_Shadow_File return String is
    begin
        return (Get_User_Prefix(Get_Userid) & Top_User_Process);
    end Current_Process_Shadow_File;

    function Get_User_Prefix(Userid : String) return String is separate;

----------------------  F I L E _ E X I S T S  ----------------------
--
--  Purpose:
--  -------
--    This routine determines if a given string refers to an accessable
--    host file.
--
--  Parameters:
--  ----------
--    Name  - the string representing the host file name.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------

    function File_Exists (
    Name : String)
    return Boolean is

    Tmp  : String (Name'range);

    begin

    if Name'last = 0 then
        return False;
    else
        Tmp := Name;
        return (0 = Cfile_Exists (Tmp'address));
    end if;

    end File_Exists;

end Cais_Host_Dependent;
--::::::::::::::
--cais_io_definitions_body.a
--::::::::::::::


----------------------------------------------------------------------
--                 I O _ D E F I N I T I O N S
--                           (Package Body)
--
--
--               This package defines the types and exceptions
--                       associated with file nodes.
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--            Thu Oct 17 08:45:44 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--                C A I S _ I O _ D E F I N I T I O N S
--
--  Purpose:
--  -------
--    This package defines the types and exceptions associated
--    with file nodes.
--
--  Usage:
--  -----
--    This package contains declarations of base types and exceptions
--    for I/O.  The operations in the interface are internal
--    suprograms for use in implementation of the I/O packages.
--
--  Notes:
--  -----
--      The     use     of     a     limited     private     type
--      (Cais_IO_Definitions.File_Type)  implies  the addition of
--      subprograms to manipulate  that  type  (e.g.  to  set  or
--      extract  the  contents of an object of that type).  These
--      are in this specification, although they are additions to
--      the  CAIS  specification  for  this  package.
--
--      This is a version of the package Cais_IO_Definitions,
--      specified in MIL-STD-CAIS section 5.3.1
--      Those portions of this specification that are NOT in
--      MIL-STD-CAIS specification (i.e. added for this implementation)
--      are so indicated.
--
--  Revision History:
--  ----------------
--    None.
--
-------------------------------------------------------------------

with Unchecked_Deallocation;

separate(Cais)
package body Io_Definitions is

    use List_Utilities;

---------------------------------  Is_Space  ---------------------------------
--
--    Local version of  function from package Character_Set
--
-------------------------------------------------------------------------------

    function Is_Space(Ch : Character) return Boolean is
    begin
        case Ch is
            when Ascii.Ht =>
                return True;
            when Ascii.Lf =>
                return True;
            when Ascii.Vt =>
                return True;
            when Ascii.Ff =>
                return True;
            when Ascii.Cr =>
                return True;
            when ' ' =>
                return True;
            when others =>
                return False;
        end case;
    end Is_Space;

-------------------------  Last_Non_Space  ------------------------------------
--
--    Local version of  function from package Character_Set
--
-------------------------------------------------------------------------------

    function Last_Non_Space(Str : String) return Integer is
        Tmp : Integer;
    begin
        Tmp := Str'Last;
        for I in reverse Str'range loop
            exit when not Is_Space(Str(I));
            Tmp := Tmp - 1;
        end loop;
        return (Tmp);
    end Last_Non_Space;


---------------------------------  Free  --------------------------------------
--
--    Local procedure for deallocating File_Type
--
-------------------------------------------------------------------------------

    procedure Free is
        new Unchecked_Deallocation(File_Rec, File_Type);
----------------------- Initialize ----------------------------
--
--  Purpose:
--  -------
--    Internal function to allocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are allocated from heap.
--
---------------------------------------------------------------------

    procedure Initialize(Ft : in out File_Type) is
    begin
        Ft := new File_Rec;
    end Initialize;

----------------------- Deallocate ----------------------------
--
--  Purpose:
--  -------
--    Internal function to deallocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are released to heap via unchecked deallocation.
--
---------------------------------------------------------------------

    procedure Deallocate(Ft : in out File_Type) is
    begin
        Free(Ft);
        null;
    end Deallocate;

----------------------- Un_Initialized ----------------------------
--
--  Purpose:
--  -------
--    Internal function to test whether file has been
--    initialized.  Returns True if not initialized,
--    otherwise returns False.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Handle is checked for null reference.
--
---------------------------------------------------------------------

    function Un_Initialized(Ft : File_Type) return Boolean is
    begin
        return (Ft = null);
    end Un_Initialized;

----------------------- Assign ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to copy one file handle record to
--    another.
--
--  Parameters:
--  ----------
--    From    (access to) source file handle record.
--    To    (access to) target file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    If the target file handle is uninitialized, Assign initializes
--    it before copying the components of the record.
--
---------------------------------------------------------------------

    procedure Assign(From : File_Type;
                     To   : in out File_Type) is
    begin
        if Un_Initialized(To) then
            Initialize(To);
        end if;
        To.Fd := From.Fd;
        To.Shadow_File_Name := From.Shadow_File_Name;
        To.Contents_File_Name := From.Contents_File_Name;
        To.Intent := From.Intent;
        To.Intent_Size := From.Intent_Size;
        To.Mode := From.Mode;
        To.Name := From.Name;
        Copy(To.Form, From.Form);
    end Assign;
-----------------------  Get_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal function to fetch (access to) the Ada file descriptor
--    for the contents file from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Text_Io.File_Type.
--    The access value returned is of type Text_File_Ptr.
--
---------------------------------------------------------------------

    function Get_File_Type(Ft : File_Type) return Text_File_Ptr is
    begin
        if Un_Initialized(Ft) then
            raise Status_Error;
        end if;
        return Ft.Fd;
    end Get_File_Type;

-----------------------  Set_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store (access to) an Ada file descriptor
--    for the contents file into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--    TFD    access to the Text_Io file descriptor.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Text_Io.File_Type.
--    The access parameter is of type Text_File_Ptr.
--
---------------------------------------------------------------------

    procedure Set_File_Type(Ft  : in out File_Type;
                            Tfd : Text_File_Ptr) is
    begin
        if Un_Initialized(Ft) then
            raise Status_Error;
        end if;
        Ft.Fd := Tfd;
    end Set_File_Type;

-----------------------  Get_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the shadow file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

    procedure Get_Shadow_File_Name(Ft       : File_Type;
                                   Name     : in out String;
                                   Lastchar : in out Natural) is

        Last : Natural;
    begin
        Last := Last_Non_Space(Ft.Shadow_File_Name);
        Name(1 .. Last) := Ft.Shadow_File_Name(1 .. Last);
        Lastchar := Last;
    end Get_Shadow_File_Name;

-----------------------  Set_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the shadow file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

    procedure Set_Shadow_File_Name(Ft   : in out File_Type;
                                   Name : String) is

        Lastchar : Natural;
    begin
        Lastchar := Last_Non_Space(Name);
        Ft.Shadow_File_Name := (others => ' ');
        Ft.Shadow_File_Name(1 .. Lastchar) := Name(1 .. Lastchar);
    end Set_Shadow_File_Name;

-----------------------  Get_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the contents file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

    procedure Get_Contents_File_Name(Ft       : File_Type;
                                     Name     : in out String;
                                     Lastchar : in out Natural) is

        Last : Natural;
    begin
        Last := Last_Non_Space(Ft.Contents_File_Name);
        Name(1 .. Last) := Ft.Contents_File_Name(1 .. Last);
        Lastchar := Last;
    end Get_Contents_File_Name;

-----------------------  Set_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the contents file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

    procedure Set_Contents_File_Name(Ft   : in out File_Type;
                                     Name : String) is

        Lastchar : Natural;
    begin
        Lastchar := Last_Non_Space(Name);
        Ft.Contents_File_Name := (others => ' ');
        Ft.Contents_File_Name(1 .. Lastchar) := Name(1 .. Lastchar);
    end Set_Contents_File_Name;

-----------------------  Get_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the intention of the node handle,
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention returned is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

    procedure Get_Intent(Ft     : File_Type;
                         Intent : in out Intention) is
    begin
        Intent := Ft.Intent(1 .. Ft.Intent_Size);
    end Get_Intent;

-----------------------  Set_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the intention of the node handle,
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention to be stored is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

    procedure Set_Intent(Ft     : in out File_Type;
                         Intent : Intention) is
    begin
        Ft.Intent(Intent'range ) := Intent;
        Ft.Intent_Size := Intent'Last;
    end Set_Intent;

-----------------------  Get_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the file mode
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode returned is the mode with which the file handle
--    was opened.
--
---------------------------------------------------------------------

    procedure Get_Mode(Ft   : File_Type;
                       Mode : in out File_Mode) is
    begin
        Mode := Ft.Mode;
    end Get_Mode;

-----------------------  Set_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the file mode
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode to be stored is the mode with which the file handle
--    is being opened (or reset).
--
---------------------------------------------------------------------

    procedure Set_Mode(Ft   : in out File_Type;
                       Mode : File_Mode) is
    begin
        Ft.Mode := Mode;
    end Set_Mode;

-----------------------  Get_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the pathname of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname returned is the pathname from the node handle
--    through which the file handle was opened.
--
---------------------------------------------------------------------

    procedure Get_Name(Ft       : File_Type;
                       Name     : in out String;
                       Lastchar : in out Natural) is

        Last : Natural;
    begin
        Last := Last_Non_Space(Ft.Name);
        Name(1 .. Last) := Ft.Name(1 .. Last);
        Lastchar := Last;
    end Get_Name;

-----------------------  Set_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the pathname of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname to be stored is the pathname from the node handle
--    through which the file handle is being opened.
--
---------------------------------------------------------------------

    procedure Set_Name(Ft   : in out File_Type;
                       Name : String) is

        Lastchar : Natural;
    begin
        Lastchar := Last_Non_Space(Name);
        Ft.Name := (others => ' ');
        Ft.Name(1 .. Lastchar) := Name(1 .. Lastchar);
    end Set_Name;

-----------------------  Get_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal function which returns the form list of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

    function Get_Form(Ft : File_Type) return List_Type is
    begin
        return Ft.Form;
    end Get_Form;

-----------------------  Set_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure which stores the form list of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Form      list of form entries.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

    procedure Set_Form(Ft   : in out File_Type;
                       Form : List_Type) is
    begin
        Copy(Ft.Form, Form);
    end Set_Form;

---------------------------------------------------------------------
end Io_Definitions;
---------------------------------------------------------------------
--::::::::::::::
--cais_sequential_io_body.a
--::::::::::::::


----------------------------------------------------------------------
--                Package  S E Q U E N T I A L _ I O
--                (Package Body)
--
--         CAIS Sequential_Io Access Method
--           Operations for File Node Input/Output
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--            Wed Oct  9 13:38:28 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--              C A I S _ S E Q U E N T I A L _ I O
--
--  Purpose:
--  -------
--        This package provides facilities for sequentially accessing
--        data elements in CAIS files.  These facilities are comparable
--        to those described in the SEQUENTIAL_IO package of the Ada LRM.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Sequential_Io
--        package.  The package is instantiated with the element
--        type of the file as parameter.  CAIS file nodes
--        correspond to ordinary Ada files, and file handles are
--        Ada objects of CAIS subtype Sequential_Io.File_Type,
--        corresponding to Ada (LRM) Sequential_Io.File_Type.
--        CAIS Sequential_Io input and output operations
--        access the contents of CAIS file nodes.
--
--  Notes:
--  -----
--        This is a version of the package CAIS.SEQUENTIAL_IO,
--        specified in MIL-STD-CAIS section 5.3.3; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.  This implementation deviates
--        from the CAIS specification in that a distinct type,
--        File_Type is employed in the package, following the
--        Ada LRM.  The package instantiates another generic
--        package, Sequential_Io_Definitions, that supports the
--        abstract data type, File_Type.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

with Sequential_Io;
with Unchecked_Conversion;

separate(Cais)
package body Sequential_Io is

    use Node_Definitions;
    use Node_Representation;
    use Node_Management;
    use Node_Internals;
    use Cais_Utilities;
    use List_Utilities;
    use Cais_Host_Dependent;
    use Seq_Io_Definitions;
    use Identifier_Items;

                                        -- Local instantiation to provide
                                        --   access to Sequential_Io operations
                                        --   using unchecked conversion from
                                        --   corresponding definition of
                                        --   pointer to Ada File_Type in private
                                        --   part of Sequential_Io_Definitions
    package Seq_Io is
        new Standard.Sequential_Io(Element_Type);
    type File_Ptr is access Seq_Io.File_Type;
    function Convert is
        new Unchecked_Conversion(Sequential_File_Ptr, File_Ptr);

    type Mode_Array is array(Positive range <>) of File_Mode;

  ----------------------------   Check_Open   -----------------------------
  --
  --    Local procedure which checks that file handle has required open status
  --
  ---------------------------------------------------------------------------

    procedure Check_Open(File            : File_Type;
                         Required_Result : Boolean) is
    begin
        if Is_Open(File) /= Required_Result then
            raise Seq_Io_Definitions.Status_Error;
        end if;
    end Check_Open;

  ----------------------------   Check_Open   -----------------------------
  --
  --    Local procedure which checks that node handle has required open status
  --
  ---------------------------------------------------------------------------

    procedure Check_Open(Node            : Cais.Node_Type;
                         Required_Result : Boolean) is
    begin
        if Is_Open(Node) /= Required_Result then
            raise Node_Definitions.Status_Error;
        end if;
    end Check_Open;

---------------------------    Check_Not_Mode    --------------------------------
--
--    Local procedure which checks that mode is not in array of
--    excluded modes
--
-------------------------------------------------------------------------------

    procedure Check_Not_Mode(File      : File_Type;
                             Bad_Modes : Mode_Array) is
    begin
        for I in Bad_Modes'range loop
            if Bad_Modes(I) = Mode(File) then
                raise Mode_Error;
            end if;
        end loop;
    end Check_Not_Mode;

---------------------------- Validate_Mode -----------------------------------
--
--    Local procedure which checks that Mode and intent of file_node
--    specified by File are consistent, and determines corresponding
--    Text_Io File_Mode.
--
-------------------------------------------------------------------------------

    procedure Validate_Mode(File    : File_Type;
                            Mode    : File_Mode;
                            Seqmode : in out Seq_Io.File_Mode) is
        Intent   : Intention(Pragmatics.Intent_Count);
        Intended : Intention(1 .. 2);
    begin
                                                        --Determine mode and
                                                        --check intentions
        Get_Intent(File, Intent);
        case Mode is
            when Seq_Io_Definitions.In_File =>
                Seqmode := Seq_Io.In_File;
                Check_Intentions(Intent, Read_Contents);
            when Seq_Io_Definitions.Out_File =>
                Seqmode := Seq_Io.Out_File;
                Check_Intentions(Intent, Write_Contents);
            when Seq_Io_Definitions.Inout_File =>
                Seqmode := Seq_Io.Out_File;
                Check_Intentions(Intent, (1 => Read_Contents, 2 =>
                    Write_Contents));
            when Seq_Io_Definitions.Append_File =>
                Seqmode := Seq_Io.Out_File;
                Check_Intentions(Intent, Append_Contents);
        end case;

    end Validate_Mode;

---------------------------- Set_For_Append -----------------------------------
--
--    Local procedure which positions a file opened in Append_File
--    mode.  To accomplish this, the Ada implementation must copy out
--    the existing contents of the file, then copy it back. The underlying
--    file is left in Out_File mode, ready to write the next
--    record after the last record in the file.
--
-------------------------------------------------------------------------------

    procedure Set_For_Append(File : in out File_Type) is
        Element            : Element_Type;
        Image_File         : Seq_Io.File_Type;
        Image_File_Name    : Name_String(1 .. Pragmatics.Max_Name_String);
        Image_Last_Char    : Natural;
        Contents_File_Name : Name_String(1 .. Pragmatics.Max_Name_String);
        Contents_Last_Char : Natural;
    begin
        Get_Contents_File_Name(File, Contents_File_Name, Contents_Last_Char);
                                -- Allocate file for temporary image
        Get_Unique_Filename(Image_File_Name, Image_Last_Char);

                                -- Copy file contents to image file
        Seq_Io.Open(Convert(Get_File_Type(File)).all, Seq_Io.In_File,
            Contents_File_Name(1 .. Contents_Last_Char));
        Seq_Io.Open(Image_File, Seq_Io.Out_File, Image_File_Name(1 ..
            Image_Last_Char));

        while not Seq_Io.End_Of_File(Convert(Get_File_Type(File)).all) loop
            Seq_Io.Read(Convert(Get_File_Type(File)).all, Element);
            Seq_Io.Write(Image_File, Element);
        end loop;
        Seq_Io.Close(Image_File);
        Seq_Io.Close(Convert(Get_File_Type(File)).all);

                                -- Copy image back to contents file
        Seq_Io.Open(Image_File, Seq_Io.In_File, Image_File_Name(1 ..
            Image_Last_Char));
        Seq_Io.Open(Convert(Get_File_Type(File)).all, Seq_Io.Out_File,
            Contents_File_Name(1 .. Contents_Last_Char));

        while not Seq_Io.End_Of_File(Image_File) loop
            Seq_Io.Read(Image_File, Element);
            Seq_Io.Write(Convert(Get_File_Type(File)).all, Element);
        end loop;
        Seq_Io.Delete(Image_File);

    end Set_For_Append;


----------------------     Create     ----------------------
--
--  Purpose:
--  -------
--        This procedure creates a file and its file node; the
--        file contains elements which may be accessed either
--        sequentially.  The attribute Access_Method is
--        assigned the value "(Sequential)" as part of the creation.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Base    open node handle to the node which will be the
--        source of the primary relationship to the new
--        node.
--    Key    relationship key of the primary relationship to
--        be created.
--    Relation    relation name of the primary relationship to be created.
--    Mode    indicates mode of the file.
--    Form    indicates file characteristics.
--    Attributes
--        initial values for attributes of the new node.
--    Access_Control
--        defines the initial access control information
--        associated with the created node.
--    Level    defines the classification label for the created node.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if a node already exists for the node specified
--        by Key and Relation or if Key or Relation is syntactically
--        illegal or if any node identifying a group specified in the
--        given Access_Control parameter is unobtainable.
--    Use_Error
--        raised if any of the parameters Access_Control, Level or
--        Attributes is syntactically or semantically illegal.
--        Use_Error is also raised if Relation is the name of a
--        predefined attribute other than File_Kind.  Also raised if
--        Relation is the name of a predefined relation which cannnot
--        be created by the user.
--    Status_Error
--        raised if Base is not an open node handle or if File is
--        an open file handle prior to the call.
--    Intent_Violation
--        raised if Base was not opened with an intent establishing
--        the right to append relationships.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.3.2 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Create that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

    procedure Create(File           : in out File_Type;
                     Base           : in out Node_Type;
                     Key            : Relationship_Key := Latest_Key;
                     Relation       : Relation_Name := Default_Relation;
                     Mode           : File_Mode := Inout_File;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type := Empty_List;
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is


        Node                   : Node_Type;
                                        --Node to be created and associated
                                        --with this File
        Kind                   : constant Node_Kind := Node_Definitions.File;
        Intent                 : Intention(1 .. 2);
        Sequential_File_Mode   : File_Mode;
        Form_String            : String(1 .. 100);

        User_Attributes        : List_Type;
        Predefined_Attributes  : List_Type;
        Predefined_Relations   : List_Type;

        New_Contents_File_Name : String(1 .. Pragmatics.Max_Contents_File_Length
            );
        File_Name_Length       : Natural;
        Last                   : Natural;


  ---------------------------  Establish_Intent  ------------------------------
  --
  --    Local procedure which converts Mode parameter to Intent vector
  --    for node handle of new file node.
  --
  -----------------------------------------------------------------------------

        procedure Establish_Intent is
        begin
            case Mode is
                when In_File =>
                    Intent := (1 => Read_Contents, 2 => Existence);
                when Out_File =>
                    Intent := (1 => Write_Contents, 2 => Existence);
                when Inout_File =>
                    Intent := (1 => Read_Contents, 2 => Write_Contents);
                when Append_File =>
                    Intent := (1 => Append_Contents, 2 => Existence);
            end case;
        end Establish_Intent;

  -------------------------- Filter_Relationships ----------------------------
  --
  --    Local procedure which screens initial values for predefined
  --    relationships of new file node.
  --    (Note:  this procedure is stubbed.)
  --
  ----------------------------------------------------------------------------

        procedure Filter_Relationships is
        begin
            Copy(Predefined_Relations, Empty_List);
        end Filter_Relationships;

  -------------------------- Filter_Attributes -------------------------------
  --
  --    Local procedure which screens initial values for predefined
  --    attributes of new file node.
  --    Attributes are divided into two lists, one for user attributes
  --    and one for predefined attributes.
  --
  ----------------------------------------------------------------------------

        procedure Filter_Attributes is

            Attribute             : List_Type;
            Name                  : Token_Type;
            List_Value            : List_Type;

            File_Kind             : Token_Type;
            File_Kind_Present     : Boolean := False;
            File_Kind_Value       : List_Type;
            Secondary_Storage     : List_Type;
            Queue                 : List_Type;

            Access_Method         : Token_Type;
            Access_Method_Present : Boolean := False;
            Access_Method_Value   : List_Type;
            Sequential            : Token_Type;
                                               -- element of Access_Method list

            Queue_Kind            : Token_Type;
            Queue_Kind_Present    : Boolean := False;
            Queue_Kind_Value      : List_Type;
            Solo                  : List_Type;

            Position              : Position_Count;
            Value_Kind            : Item_Kind;

            Result_List           : List_Type;


        --------------------------  Check_And_Set  ------------------------
        --
        --    Local procedure which checks and sets a Boolean variable used
        --    for recording predefined attributes seen.
        --
        ----------------------------------------------------------------------

            procedure Check_And_Set(Attribute_Present : in out Boolean) is
            begin
                if Attribute_Present then
                    Trace.Report(
                        "CAIS Use_Error: Duplicate attribute in Cais.Sequential_Io.Create"
                        );
                    raise Node_Definitions.Use_Error;
                else
                    Attribute_Present := True;
                end if;
            end Check_And_Set;


        -------------------------  Check_Syntax  ------------------------
        --
        --    Local procedure used for checking that list elements have
        --    the required item kind.
        --
        -----------------------------------------------------------------

            procedure Check_Syntax(Value_Kind    : Item_Kind;
                                   Required_Kind : Item_Kind) is
            begin
                if Value_Kind /= Required_Kind then
                    Trace.Report(
                        "CAIS Use_Error: Bad attribute value in Cais.Sequential_Io.Create"
                        );
                    raise Node_Definitions.Use_Error;
                end if;
            end Check_Syntax;

        begin

        -- Validate and filter predefined attributes
        --  into a list of initial values for predefined
        --  attributes, and a list of attributes which are
        --  user attributes to be created.
            Copy(User_Attributes, Empty_List);
            Copy(Predefined_Attributes, Empty_List);

            To_Token("File_Kind", File_Kind);
            To_List("(Secondary_Storage)", Secondary_Storage);
            To_List("(Queue)", Queue);

            To_Token("Access_Method", Access_Method);
            To_Token("Sequential", Sequential);

            To_Token("Queue_Kind", Queue_Kind);
            To_List("(Solo)", Solo);
                                        -- Set defaults
            To_List("(Secondary_Storage)", File_Kind_Value);
            To_List("(Sequential)", Access_Method_Value);
            To_List("(Solo)", Queue_Kind_Value);

                                        -- Filter attribute list
            if Get_List_Kind(Attributes) = Unnamed then
                raise Seq_Io_Definitions.Use_Error;
            end if;

            for I in 1 .. Length(Attributes) loop

                                                -- extract and check attributes
                Value_Kind := Get_Item_Kind(Attributes, I);
                Check_Syntax(Value_Kind, List_Item);
                Item_Name(Attributes, I, Name);
                if Predefined(To_Text(Name), Cais_Utilities.Attribute) then
                                                -- check for File_Kind
                    if Is_Equal(Name, File_Kind) then
                        Check_And_Set(File_Kind_Present);
                        Extract(Attributes, File_Kind, File_Kind_Value);
                        if not Is_Equal(File_Kind_Value, Secondary_Storage) and
                            then not Is_Equal(File_Kind_Value, Queue) then
                            Trace.Report(
                                "CAIS Use_Error: Invalid File_Kind in Cais.Sequential_Io.Create"
                                );
                            raise Seq_Io_Definitions.Use_Error;
                        end if;

                                                -- check for Queue_Kind
                    elsif Is_Equal(Name, Queue_Kind) then
                        Check_And_Set(Queue_Kind_Present);
                        Extract(Attributes, Queue_Kind, Queue_Kind_Value);
                        if not Is_Equal(Queue_Kind_Value, Solo) then
                            Trace.Report(
                                "CAIS Use_Error: Invalid File_Kind in Cais.Sequential_Io.Create"
                                );
                            raise Seq_Io_Definitions.Use_Error;
                        end if;

                                                -- check for Access_Method
                    elsif Is_Equal(Name, Access_Method) then
                        Check_And_Set(Access_Method_Present);
                        Extract(Attributes, Access_Method, List_Value);

                        begin   --  SEQUENTIAL must be included
                            Position := Position_By_Value(List_Value, Sequential
                                );
                            Copy(Access_Method_Value, List_Value);
                        exception
                            when Search_Error =>
                                Trace.Report(
                                    "CAIS Use_Error: Invalid Access_Method in Cais.Sequential_Io.Create"
                                    );
                                raise Seq_Io_Definitions.Use_Error;
                            when others =>
                                raise;
                        end;


                    else
                        Trace.Report(
                            "CAIS Use_Error: Invalid predefined attribute in Cais.Sequential_Io.Create"
                            );
                        raise Seq_Io_Definitions.Use_Error;
                    end if;

                else            -- others must be user attributes
                    Extract(Attributes, Name, List_Value);
                    Insert(User_Attributes, List_Value, Name, 0);
                end if;
            end loop;

                                        -- Check consistent use of File_Kind
                                        --  Queue, and Queue_Kind attributes
            if Queue_Kind_Present then
                if not Is_Equal(File_Kind_Value, Queue) then
                    Trace.Report(
                        "CAIS Use_Error: Inconsistent Queue_Kind attribute in Cais.Sequential_Io.Create"
                        );
                    raise Seq_Io_Definitions.Use_Error;
                end if;
            end if;

                                        -- Attribute filter completed
                                        -- Construct predefined attribute list

                                        -- Initial value for Access_Method attr
            Insert(Predefined_Attributes, Access_Method_Value, Access_Method, 0)
                ;

            Insert(Predefined_Attributes, File_Kind_Value, File_Kind, 0);

            if Is_Equal(File_Kind_Value, Queue) then
                Insert(Predefined_Attributes, Queue_Kind_Value, Queue_Kind, 0);
            end if;

        end Filter_Attributes;


  -----------------------  Establish_Contents_File  ---------------------------
  --
  --    Local procedure used to obtain a uniquely-named contents file
  --    for the new file node, and record its name in the node handle.
  --
  -----------------------------------------------------------------------------

        procedure Establish_Contents_File is
        begin
            Cais_Host_Dependent.Get_Unique_Filename(New_Contents_File_Name,
                File_Name_Length);
            Set_Contents_File_Name(Node, New_Contents_File_Name(1 ..
                File_Name_Length));

        end Establish_Contents_File;

    begin-- Cais.Sequential_Io.Create

        Check_Open(Base, True);
                             -- check that node handle is open
                             -- (Node_Definitions.Status_Error)
        Check_Open(File, False);
                              -- check that file handle is not open
                             -- (Seq_Io_Definitions.Status_Error)
        Establish_Intent;
        Filter_Relationships;
        Filter_Attributes;
        Establish_Contents_File;
        Initialize(File);

        -- Actually create the new file node
        --   (establishes its shadow file, checks status, sets attributes,
        --    opens file node)
        Node_Internals.Create_Node(Node => Node, Base => Base, Kind => Kind,
            Internals_Attributes => Predefined_Attributes, User_Attributes =>
            User_Attributes, Internals_Relations => Predefined_Relations, Intent
            => Intent, Access_Control => Access_Control, Level => Level, Key
            => Key, Relation => Relation);

        -- Open the file handle
        Open(File, Node, Mode);

    exception

    -- exceptions that are propagated
        when Seq_Io_Definitions.Name_Error | Seq_Io_Definitions.Use_Error |
            Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Device_Error |
            Node_Definitions.Intent_Violation | Node_Definitions.
            Security_Violation =>
            raise;

    -- exceptions that are mapped to other exceptions
        when Node_Definitions.Name_Error =>
            raise Seq_Io_Definitions.Name_Error;
        when Node_Definitions.Use_Error =>
            raise Seq_Io_Definitions.Use_Error;
        when Node_Definitions.Status_Error =>
            raise Seq_Io_Definitions.Status_Error;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Create ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Create "
                );
            raise Trace.Assertion_Violation;

    end Create;

-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

    procedure Create(File           : in out File_Type;
                     Name           : Name_String;
                     Mode           : File_Mode := Inout_File;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type := Empty_List;
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is
        Base : Node_Type;
    begin
        Open(Base, Base_Path(Name), (1 => Append_Relationships));
        Create(File, Base, Last_Key(Name), Last_Relation(Name), Mode, Form,
            Attributes, Access_Control, Level);
        Close(Base);
    exception
        when others =>
            Close(File);
            Close(Base);
            raise;
    end Create;

----------------------     Open     ----------------------
--
--  Purpose:
--  -------
--    This procedure opens a file handle on a file containing
--    elements of the generic parameter type, given an open node
--    handle on the file node.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Node    open node handle to the file node.
--    Mode    indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    Use_Error
--        raised if the attribute Access_Method of the file node
--        does not have the value Sequential or the element type of the
--        file does not correspond with the element type of this
--        instantiation of the CAIS Sequential_Io package.
--
--        also raised if the node identified by Node has a value of
--        Queue for the attribute File_Kind and a value of Mimic for
--        the attribute Queue_Kind and the mimic queue file identified
--        by File is being opened with Mode other than In_File but the
--        coupled file has been deleted.
--
--    Status_Error
--        raised if File is an open file handle at the time of the call
--        or if Node is not an open node handle.
--
--    Intent_Violation
--        raised if Node has not been opened with an intent
--        establishing the access rights required for the Mode.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.3.3 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Open that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

    procedure Open(File : in out File_Type;
                   Node : Node_Type;
                   Mode : File_Mode) is
        File_Name           : Name_String(1 .. Pragmatics.Max_Name_String);
        Sequentialmode      : Seq_Io.File_Mode := Seq_Io.In_File;
        Last_File_Char      : Natural;
        Last_Path_Char      : Natural;

        Pathname            : Name_String(1 .. Pragmatics.Max_Name_String);
        Position            : Position_Count;
        Attribute_List      : List_Type;

        Access_Method       : Token_Type;
        Access_Method_Value : List_Type;
        Sequential          : Token_Type;

        File_Kind           : Token_Type;
        File_Kind_Value     : List_Type;
        Queue               : List_Type;

        Queue_Kind          : Token_Type;
        Queue_Kind_Value    : List_Type;
        Mimic               : List_Type;


    begin

        Check_Open(Node, True);
                              -- Node_Definitions.Status_Error if not open
        Check_Open(File, False);
                               -- Seq_Io_Definitions.Status_Error if open

                                -- check that node is file node
        if Get_Kind(Node) /= Node_Definitions.File then
            raise Node_Definitions.Use_Error;
        end if;

        Initialize(File);
        Set_Intent(File, Get_Intent(Node));                     --Set intentions
        Get_Shadow_File_Name(Node, File_Name, Last_File_Char);
                                                        --Set Shadow file
        Set_Shadow_File_Name(File, File_Name(1 .. Last_File_Char));
        Get_Contents_File_Name(Node, File_Name, Last_File_Char);
                                                        --Set contents file
        Set_Contents_File_Name(File, File_Name(1 .. Last_File_Char));
        Get_Pathname(Node, Pathname, Last_Path_Char);           --Set file node name
        Set_Name(File, Pathname(1 .. Last_Path_Char));

        Get_Node_Attributes(Node, Attribute_List);
        To_Token("Access_Method", Access_Method);
        To_Token("Sequential", Sequential);
        begin                   -- Check Access_Method includes Sequential
            Extract(Attribute_List, Access_Method, Access_Method_Value);
            Position := Position_By_Value(Access_Method_Value, Sequential);

        exception
            when List_Utilities.Search_Error =>
                Trace.Report(
                    "CAIS Use_Error: Invalid Access_Method in Cais.Sequential_Io.Open "
                    );
                Trace.Report("Access_Method: " & To_Text(Access_Method_Value));
                Trace.Report("Expected list containing: (Sequential)");
                raise Seq_Io_Definitions.Use_Error;

        end;

        To_Token("File_Kind", File_Kind);
        Extract(Attribute_List, File_Kind, File_Kind_Value);
        To_List("(Queue)", Queue);
        if Is_Equal(File_Kind_Value, Queue) then
            To_Token("Queue_Kind", Queue_Kind);
            Extract(Attribute_List, Queue_Kind, Queue_Kind_Value);
            To_List("(Mimic)", Mimic);
            if Is_Equal(File_Kind_Value, Queue) and then Is_Equal(
                Queue_Kind_Value, Mimic) and then Mode /= In_File
           --!stub  and then coupled file has been deleted
            then
                Trace.Report(
                    "CAIS Use_Error: Mimic queue has coupled file deleted");
                Trace.Report("                Mode is not In_File");
                raise Seq_Io_Definitions.Use_Error;
            end if;
        end if;


        Validate_Mode(File, Mode, Sequentialmode);      --checks modes and
                                                        --proper intentions
                                                        --Check Use errors
        Set_Mode(File, Mode);                   --Set Mode

        if Mode = Append_File then
            Set_For_Append(File);               --Open for Append_File
        else                                    --Open file
            Seq_Io.Open(Convert(Get_File_Type(File)).all, Sequentialmode,
                File_Name(1 .. Last_File_Char));
        end if;

    exception

    -- exceptions that are propagated
        when Seq_Io_Definitions.Use_Error | Seq_Io_Definitions.Status_Error |
            Seq_Io_Definitions.Device_Error | Node_Definitions.Intent_Violation
            =>
            raise;


    -- exceptions that are mapped to other exceptions
    -- Search_Error looking for Sequential in Access_Method list is
    --    mapped to Use_Error.
        when Node_Definitions.Use_Error =>
            raise Seq_Io_Definitions.Use_Error;
        when Node_Definitions.Status_Error =>
            raise Seq_Io_Definitions.Status_Error;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Open ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Open ")
                ;
            raise Trace.Assertion_Violation;

    end Open;

-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

    procedure Open(File : in out File_Type;
                   Name : Name_String;
                   Mode : File_Mode) is
        Node : Node_Type;
    begin
        case Mode is
            when In_File =>
                Open(Node, Name, (1 => Read_Contents));
            when Out_File =>
                Open(Node, Name, (1 => Write_Contents));
            when Inout_File =>
                Open(Node, Name, (Read_Contents, Write_Contents));
            when Append_File =>
                Open(Node, Name, (1 => Append_Contents));
        end case;

        Open(File, Node, Mode);
        Close(Node);
    exception
        when others =>
            if Is_Open(File) then
                Close(File);
            end if;
            Close(Node);
            raise;
    end Open;

----------------------     Close     ----------------------
--
--  Purpose:
--  -------
--    Closes file handle to CAIS file node.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    procedure Close(File : in out File_Type) is
    begin
        Check_Open(File, True);         -- Status_Error if not open
        Seq_Io.Close(Convert(Get_File_Type(File)).all); -- Close contents file
        Deallocate(File);                       -- Deallocate file handle
    exception
    -- exceptions that are propagated
        when Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Device_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Close ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Close ")
                ;
            raise Trace.Assertion_Violation;

    end Close;

----------------------     Delete     ----------------------
--
--  Purpose:
--  -------
--    This procedure deletes the CAIS file identified
--    by File.
--    In addition to the semantics specified in the LRM,
--    the node associated with the open file handle File
--    is made unobtainable as if a call to the Delete_Node
--    procedure had been made.
--
--  Parameters:
--  ----------
--    File    an open file handle on the file being deleted.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if the parent node of the node associated with
--        the file identified by File is inaccessible.
--    Use_Error
--        raised if any primary relationships emanate from the
--        node associated with the file identified by File.
--    Status_Error
--        raised if File is not an open file handle.
--    Lock_Error
--        raised if access with intent Write_Relationships to the
--        parent of the node to be deleted cannot be obtained due
--        to an existing lock on the node.
--    Access_Violation
--        raised if the current process does not have sufficient
--        discretionary access control rights to obtain access to
--        the parent of the node to be deleted with intent
--        Exclusive_Write; only raised if the conditions for
--        Name_Error are not present.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.3.4 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Delete(File : in out File_Type) is
        Name : String(1 .. Pragmatics.Max_Name_String);
        Node : Node_Type;
        Last : Natural;
    begin
        Check_Open(File, True);  -- Status_Error if not open

        Get_Name(File, Name, Last);     -- Get file node name
        Close(File);                    -- Close contents file
        Open(Node, Name(1 .. Last),             -- Make file node unobtainable
        (1 => Read_Relationships, 2 => Exclusive_Write));
        Delete_Node(Node);

    exception

    -- exceptions that are propagated
        when Seq_Io_Definitions.Use_Error | Seq_Io_Definitions.Status_Error |
            Seq_Io_Definitions.Device_Error | Node_Definitions.Lock_Error |
            Node_Definitions.Access_Violation | Node_Definitions.
            Security_Violation =>
            raise;


    -- exceptions that are mapped to other exceptions
        when Node_Definitions.Name_Error =>
            raise Seq_Io_Definitions.Name_Error;
        when Node_Definitions.Use_Error =>
            raise Seq_Io_Definitions.Use_Error;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Delete ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Delete "
                );
            raise Trace.Assertion_Violation;

    end Delete;

----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset the file mode of a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--    Mode    Indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    See note.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    Semantics of this procedure are not restricted to Ada LRM
--    semantics, pending clarification of the interaction of access
--    methods in the CAIS.
--
--    Although no exceptions are defined in the CAIS, checking of
--    Status_Error and Use_Error for invalid mode is done.
---------------------------------------------------------------------

    procedure Reset(File : in out File_Type;
                    Mode : File_Mode) is
        Seqmode : Seq_Io.File_Mode := Seq_Io.In_File;
    begin
        Check_Open(File, True);         -- Status_Error if not open
        Validate_Mode(File, Mode, Seqmode); -- Confirm access rights
        Set_Mode(File, Mode);                -- Record current CAIS mode
        Seq_Io.Reset(Convert(Get_File_Type(File)).all, Seqmode); -- Reset contents file
    exception

      -- exceptions that are propagated
        when Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Use_Error |
            Seq_Io_Definitions.Device_Error | Node_Definitions.Intent_Violation
            =>
            raise;


      -- exceptions that are mapped to other exceptions

      -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Reset ");
            raise;

      -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Reset ")
                ;
            raise Trace.Assertion_Violation;

    end Reset;


----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    Semantics of this procedure are not restricted to Ada LRM
--    semantics, pending clarification of the interaction of access
--    methods in the CAIS.
---------------------------------------------------------------------

    procedure Reset(File : in out File_Type) is
    begin
        Check_Open(File, True);         -- Status_Error if not open
        Seq_Io.Reset(Convert(Get_File_Type(File)).all); -- Reset contents file
    exception
        -- exceptions that are propagated
        when Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Use_Error |
            Seq_Io_Definitions.Device_Error =>
            raise;

        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Reset ");
            raise;

        -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Reset ")
                ;
            raise Trace.Assertion_Violation;

    end Reset;

----------------------     Mode     ----------------------
--
--  Purpose:
--  -------
--    Returns the current mode of the current CAIS file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Mode(File : File_Type) return File_Mode is
        Mode : File_Mode;
    begin
        Check_Open(File, True);         -- Status_Error if not open
        Seq_Io_Definitions.Get_Mode(File, Mode);
        return Mode;
    exception
        -- exceptions that are propagated
        when Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Device_Error
            =>
            raise;

        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Mode ");
            raise;

        -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Mode ")
                ;
            raise Trace.Assertion_Violation;

    end Mode;

----------------------     Name     ----------------------
--
--  Purpose:
--  -------
--    Returns a string containing the name of the CAIS file
--    node currently associated with the file handle.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Name(File : File_Type) return String is
        File_Node_Name : String(1 .. Pragmatics.Max_Name_String);
        Last           : Natural;
    begin
        Check_Open(File, True);         -- Status_Error if not open
        Get_Name(File, File_Node_Name, Last);
        return File_Node_Name(1 .. Last);
    exception
        -- exceptions that are propagated
        when Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Device_Error
            =>
            raise;

        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Name ");
            raise;

        -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Name ")
                ;
            raise Trace.Assertion_Violation;

    end Name;

----------------------     Form     ----------------------
--
--  Purpose:
--  -------
--    Returns the form string for the external file currently
--    associated with the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Form(File : File_Type) return String is
    begin
        Check_Open(File, True);         -- Status_Error if not open
        return Seq_Io.Form(Convert(Get_File_Type(File)).all);
    exception
        -- exceptions that are propagated
        when Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Device_Error
            =>
            raise;

        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Form ");
            raise;

        -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Form ")
                ;
            raise Trace.Assertion_Violation;

    end Form;

----------------------     Is_Open     ----------------------
--
--  Purpose:
--  -------
--    Returns TRUE if the file handle is open, otherwise returns FALSE.
--
--  Parameters:
--  ----------
--    File    file handle.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Is_Open(File : File_Type) return Boolean is
    begin
        return (not Un_Initialized(File)) and then Seq_Io.Is_Open(Convert(
            Get_File_Type(File)).all);
    exception
        -- exceptions that are propagated
        when Seq_Io_Definitions.Device_Error =>
            raise;

        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Is_Open ")
                ;
            raise;

        -- unanticipated exceptions
        when others =>
            Trace.Report(
                "UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Is_Open ");
            raise Trace.Assertion_Violation;

    end Is_Open;


---------------------------     Read     ---------------------------
--
--  Purpose:
--  -------
--    Reads an element from the given file, and returns the value
--    of this element in the Item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    returns element read from file.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if the mode is not In_File.
--    End_Error
--        raised if no more elements can be read from the
--        given file.
--    Data_Error
--        raised if the element read cannot be interpreted
--        as a value of the generic parameter type.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.2.
--
---------------------------------------------------------------------

    procedure Read(File : File_Type;
                   Item : in out Element_Type) is
    begin
        Check_Open(File, True);         -- Status_Error if not open
        Seq_Io.Read(Convert(Get_File_Type(File)).all, Item);
    exception
        -- exceptions that are propagated
        when Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Mode_Error |
            Seq_Io_Definitions.Data_Error | Seq_Io_Definitions.End_Error |
            Seq_Io_Definitions.Device_Error =>
            raise;

        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Read ");
            raise;

        -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Read ")
                ;
            raise Trace.Assertion_Violation;

    end Read;

---------------------------     Write     ---------------------------
--
--  Purpose:
--  -------
--    Writes the value of Item to the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    element to be written to the file.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if mode is not Out_File.
--    Use_Error
--        raised if the capacity of the file is exceeded.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.2.
--
---------------------------------------------------------------------

    procedure Write(File : File_Type;
                    Item : Element_Type) is
    begin
        Check_Open(File, True);         -- Status_Error if not open
        Seq_Io.Write(Convert(Get_File_Type(File)).all, Item);
    exception
        -- exceptions that are propagated
        when Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Use_Error |
            Seq_Io_Definitions.Mode_Error | Seq_Io_Definitions.Device_Error =>
            raise;

        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Sequential_Io.Write ");
            raise;

        -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Sequential_Io.Write ")
                ;
            raise Trace.Assertion_Violation;

    end Write;

----------------------     End_Of_File     ----------------------
--
--  Purpose:
--  -------
--    Returns True if no more elements can be read from the
--    given file;  otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.2.
--
---------------------------------------------------------------------

    function End_Of_File(File : File_Type) return Boolean is
    begin
        Check_Open(File, True);         -- Status_Error if not open
        return Seq_Io.End_Of_File(Convert(Get_File_Type(File)).all);

    exception
        -- exceptions that are propagated
        when Seq_Io_Definitions.Status_Error | Seq_Io_Definitions.Mode_Error |
            Seq_Io_Definitions.Device_Error =>
            raise;

        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report(
                "PREDEFINED EXCEPTION in Cais.Sequential_Io.End_Of_File ");
            raise;

        -- unanticipated exceptions
        when others =>
            Trace.Report(
                "UNANTICIPATED EXCEPTION in Cais.Sequential_Io.End_Of_File ");
            raise Trace.Assertion_Violation;

    end End_Of_File;

---------------------------------------------------------------------
end Sequential_Io;
---------------------------------------------------------------------
--::::::::::::::
--cais_spec.a
--::::::::::::::
with Calendar; use Calendar;
with Text_Io;  -- Not in Cais spec
with Direct_Io;  -- Not in Cais spec
with Sequential_Io;  -- Not in Cais spec
with Io_Exceptions;
package Cais is

    type Node_Type is limited private;
----------------------------------------------------------------------
--                       P R A G M A T I C S
--
--  Purpose:
--  -------
--    This package is the central location for implementation-defined
--    limits and values (e.g. maximum length of a CAIS pathname).
--    It is intended to limit the use of "magic numbers" distributed
--    throughout the CAIS prototype code.
--
--  Usage:
--  -----
--    Constants can be used in data structure declarations, constraint
--    checks, etc.
--
--  Example:
--  -------
--    Pathname_String  : String (1..Pragmatics.Max_Name_String);
--
--  Notes:
--  -----
--    None.
--
--  Revision History:
--  ----------------
--    None.
--
-------------------------------------------------------------------

    package Pragmatics is


        Max_Name_String          : constant := 255;
                                                 -- CAIS 4.5.1

        Max_Relationship_Key     : constant := 80;
                                                 -- CAIS 4.5.1

        Max_Attribute_Name       : constant := 80;
                                                 -- CAIS 4.5.1

        Max_Relationship_Name    : constant := 80;
                                                 -- CAIS 4.5.1

    -- this should be set to the maximum of
    -- Max_Relationship_Key, Max_Relationship_Name, Max_Attribute_Name
        Max_Token_Size           : constant := 80;

        Max_Shadow_File_Length   : constant := 100;
                                               -- arbitrary length

        Max_Contents_File_Length : constant := 100;
                                                -- arbitrary length

        Max_Userid_Length        : constant := 10;
                                               -- arbitrary length

        Max_User_Prefix_Length   : constant := 100;
                                               -- arbitrary length

        Max_List_Length          : constant := 5000;
                                          -- arbitrary length

        subtype Intent_Count is Integer range 1 .. 32;
    end Pragmatics;
----------------------------------------------------------------------
--              C A I S _ N O D E _ D E F I N I T I O N S
--
--  Function:
--  --------
--      This package defines the Ada subtype "Node_Type".  It defines
--      certain enumeration and String types, and exceptions useful for
--      CAIS node manipulations.
--
--  Usage:
--  -----
--    TBS
--
--  Example:
--  -------
--    TBS
--
--  Notes:
--  -----
--      This is a version of the package Node_Definitions,
--      specified in MIL-STD-CAIS section 5.1.1
--    The definition of type Node_Type is moved to package Cais in
--    anticipation of a change in the MIL-STD-CAIS.
--      Other portions of this specification that are NOT in
--      MIL-STD-CAIS specification (i.e. added for this implementation)
--      are so indicated.
--
--  Revision History:
--  ----------------
--

    package Node_Definitions is

        subtype Node_Type is Cais.Node_Type;

        type Node_Kind is (File, Structural, Process);

        type Intent_Specification is (Existence, Read, Write, Read_Attributes,
            Write_Attributes, Append_Attributes, Read_Relationships,
            Write_Relationships, Append_Relationships, Read_Contents,
            Write_Contents, Append_Contents, Control, Execute, Exclusive_Read,
            Exclusive_Write, Exclusive_Read_Attributes,
            Exclusive_Write_Attributes, Exclusive_Append_Attributes,
            Exclusive_Read_Relationships, Exclusive_Write_Relationships,
            Exclusive_Append_Relationships, Exclusive_Read_Contents,
            Exclusive_Write_Contents, Exclusive_Append_Contents,
            Exclusive_Control);

        type Intention is array(Positive range <>) of Intent_Specification;

        subtype Name_String is String;
        subtype Relationship_Key is String;
        subtype Relation_Name is String;
        subtype Form_String is String;


        Current_User       : constant Name_String := "'Current_User";
        Current_Node       : constant Name_String := "'CURRENT_NODE";
        Current_Process    : constant Name_String := ":";
        Latest_Key         : constant Relationship_Key := "#";
        Default_Relation   : constant Relation_Name := "DOT";
        No_Delay           : constant Duration := Duration'First;


        Status_Error       : exception;
        Name_Error         : exception;
        Use_Error          : exception;
        Lock_Error         : exception;
        Access_Violation   : exception;
        Intent_Violation   : exception;
        Security_Violation : exception;


    end Node_Definitions;

----------------------------------------------------------------------
--                   L I S T _ U T I L I T I E S
--
--  Purpose:
--  -------
--    List_Utilities provides operations for objects of List_Type.  These
--    objects are heterogeneous lists of string, integer, float, sub-list,
--    and list items.  Operations provided include Insert, Extract, Replace,
--    Delete, and a value search.  Conmversions to and from text are also
--    provided.  Lists may be named or unnamed.  Related packages are
--    String_Items, Identifier_Items, Integer_Items, and Float_Items.
--  Usage:
--  -----
--    Lists are used to represent attribute values and parameters in CAIS.
--    Implementations may use Lists to represent relationships.
--
--  Example:
--  -------
--        To_List("(Integers=>(1,2), Identifier=>Ada_Name)", Sample);
--        Extract(Sample, 1, Integer_List);
--  Notes:
--  -----
--    The visibility of the internal package V_String is questionable and
--    should possibly be hidden.
--  Revision History:
--  ----------------
--    12-01-85 Changed Text_Length for Items: they now return Natural since
--         length may be 0 when item is a null string
--    12-01-85 Removed specification for V_String which was added to
--         List_Utilities_body.  V_String is now hidden in List_Utilities
--
-------------------------------------------------------------------
    package List_Utilities is


   -- The following type and exception declarations are from
   -- CAIS 5.4.1.1

        type List_Type is limited private;
        type Token_Type is limited private;
        subtype Namestring is String;

        type List_Kind is (Unnamed, Named, Empty);
                                              -- See note above re "empty"

        type Item_Kind is (List_Item, String_Item, Integer_Item, Float_Item,
            Identifier_Item);

        subtype List_Text is String;
        subtype Element_Text is String;    --ADDITION TO MIL_STD CAIS
        type Count is range 0 .. Integer'Last;
        subtype Position_Count is Count range Count'First + 1 .. Count'Last;

        Search_Error : exception;
        Empty_List   : constant List_Type;


-----------------------C O P Y----------------------------------
--
-- Purpose:
-- ---------
--    Returns in the the parameter T0_List a copy of the list value
--    of the parameter From_List.  Subsequent modification of either
--    list does not affect the other list.
--
-- Parameters:
-- ----------
--    To_List   is the list returned as a copy of the value of From_List
--    From_List is thew list to be copied.
--
-- Exceptions:
-- ----------
--    None
--
-- Notes: MIL_STD CAIS 5.4.1.2
-- -----
--    None
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.2
        procedure Copy(To_List   : in out List_Type;
                       From_List : in List_Type);

---------------------T O _ L I S T------------------------------
--
-- Purpose:
-- -------
--     Converts the external representation of a list to List_Type
--     and returns the converted value.  This function establishes
--     the list to be of named, unnamed, or null kind.
--
-- Parameters:
-- ----------
--     List_Literal is the string representation to be converted to a list
--     List         is the List_Type internal representation of List_Literal
--
--
-- Exceptions:
-- ----------
--     Use_Error is raised if ther is a syntax error.
--
-- Notes:  MIL_STD CAIS 5.4.1.3
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.3
        procedure To_List(List_Literal : in List_Text;
                          List         : in out List_Type);

--------------------T O _ T E X T-------------------------------
--
-- Purpose:
-- -------
--     Returns thje external representation of the value of
--     list, as defined in MIL_STD CAIS 5.4
--
--
-- Parameters:
-- ----------
--     List   is a list_type to be converted to text
--     return string representation of List
--
-- Exceptions:
-- ----------
--     None
--
--
--
-- Notes: MIL_STD CAIS 5.4.1.4
-- -----
--
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.4
        function To_Text(List : in List_Type) return List_Text;

--------------------I S _ E Q U A L-----------------------------
--
-- Purpose:
-- -------
--     returns True if the two lists are equal as determined by:
--
--    - Both lists are of the same kind (named, unnamed, or empty)
--    - Both lists contain the same number of items
--    - For each position, the values of list items at this position,
--      as obtained by Extract, are of the same kind and are equal
--      under the equality defined for this kind
--    - In thew case of named lists, for each position, the names of the
--      items at this position are equal under Token_Type equality
--
-- Parameters:
-- ----------
--        List1  is List_Type to be compared
--        List2  is List_Type to be compared
--        return TRUE if lists are of the same kind, have the same number
--         of items, and all corresponding names and items are equal
--
--
-- Exceptions:
-- ----------
--      None
--
-- Notes: MIL_STD CAIS 5.4.1.5
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.5
        function Is_Equal(List1 : in List_Type;
                          List2 : in List_Type) return Boolean;


--------------------D E L E T E----POSITIONAL ITEM--------------
--
-- Purpose:
-- -------
--     Removes the list item at this position from the list
--
--
-- Parameters:
-- ----------
--     List     is the list from which an item is to be deleted, positional
--     Position is the position of the item to be deleted.
--
--
-- Exceptions:
-- ----------
--     Use_Error    may be raised by Find if bad position
--
--
-- Notes: MIL_STD CAIS 5.4.1.6
-- -----
--
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.6
        procedure Delete(List     : in out List_Type;
                         Position : in Position_Count);

--------------------D E L E T E----NAMED     ITEM--------------
--
-- Purpose:
-- -------
--     Removes the list item of this name  from the list
--
--
-- Parameters:
-- ----------
--     List     is the list from which an item is to be deleted, named
--     Named    is the name of the item to be deleted.
--
--
-- Exceptions:
-- ----------
--     Search_Error    may be raised by find if name doesn't exist
--     Use_Error       may be raised by find if list is not named
--
--
-- Notes: MIL_STD CAIS 5.4.1.6
-- -----
--
--
----------------------------------------------------------------
        procedure Delete(List  : in out List_Type;
                         Named : in Namestring);

--------------------D E L E T E----NAMED  ITEM OF TOKEN TYPE---
--
-- Purpose:
-- -------
--     Removes the list item of this name  from the list
--
--
-- Parameters:
-- ----------
--     List     is the list from which an item is to be deleted, named
--     Named    is the name (in token form) of the item to be deleted.
--
--
-- Exceptions:
-- ----------
--     Search_Error    may be raised by find if name doesn't exist
--     Use_Error       may be raised by find if list is not named
--
--
-- Notes: MIL_STD CAIS 5.4.1.6
-- -----
--
--
----------------------------------------------------------------
        procedure Delete(List  : in out List_Type;
                         Named : in Token_Type);


---------------G E T _ L I S T _ K I N D----------------OF LIST-
--
-- Purpose:
-- -------
--     Returns the kind of list, either empty, unnamed, or named.
--
-- Parameters:
-- ----------
--     List    is the list_type being looked at
--     return  the kind of list, either empty, unnamed, or named
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.7
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.7
        function Get_List_Kind(List : in List_Type) return List_Kind;

----------------G E T _ I T E M _ K I N D------------OF UNNAMED ITEM--
--
-- Purpose:
-- -------
--     Returns the kind of a single list item within an unnamed list.
--     The item kinds are LIST_ITEM, STRING_ITEM, INTEGER_ITEM,
--     REAL_ITEM, and IDENTIFIER_ITEM.
--
-- Parameters:
-- ----------
--     List      is the unnamed list containing the item of interest
--     Position  is the position of the item of interest
--     return    the item_kind of the specified item
--
-- Exceptions:
-- ----------
--     Use_Error       may be propogated by Find for no names or bad position
--
-- Notes: MIL_STD CAIS 5.4.1.8
--
------------------------------------------------------------------------------
        function Get_Item_Kind(List  : in List_Type;
                               Named : in Namestring) return Item_Kind;


----------------G E T _ I T E M _ K I N D------------OF NAMED ITEM--
--
-- Purpose:
-- -------
--     Returns the kind of a single list item within a named list.
--     The item kinds are LIST_ITEM, STRING_ITEM, INTEGER_ITEM,
--     REAL_ITEM, and IDENTIFIER_ITEM.
--
-- Parameters:
-- ----------
--     List      is the named list containing the item of interest
--     Named     is the name of the item of interest
--     return    the item_kind of the specified item
--
-- Exceptions:
-- ----------
--     Search_Error    may be propogated from Find if name doesn't exist
--     Use_Error       may be propogated by Find if list is unnamed
--
-- Notes: MIL_STD CAIS 5.4.1.8
-- -----
--
----------------------------------------------------------------
        function Get_Item_Kind(List  : in List_Type;
                               Named : in Token_Type) return Item_Kind;
------------G E T _ I T E M _ K I N D--------OF NAMED ITEM-TOKEN---
--
-- Purpose:
-- -------
--     Returns the kind of a single list item within a named list.
--     The item kinds are LIST_ITEM, STRING_ITEM, INTEGER_ITEM,
--     REAL_ITEM, and IDENTIFIER_ITEM.
--
-- Parameters:
-- ----------
--     List      is the named list containing the item of interest
--     Named     is the name (in token form) of the item of interest
--     return    the item_kind of the specified item
--
-- Exceptions:
-- ----------
--     Search_Error    may be propogated from Find if name doesn't exist
--     Use_Error       may be propogated by Find if list is unnamed
--
-- Notes: MIL_STD CAIS 5.4.1.8
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.8
        function Get_Item_Kind(List     : in List_Type;
                               Position : in Position_Count) return Item_Kind;

-----------------------S P L I C E-----TEXT---------------------
--
-- Purpose:
-- -------
--     Inserts a list into a list.  The items in the list to be inserted
--     will become items in the resulting list.  Subsequent modifications
--     to the value of List or to the value of Sub_List do not affect the
--     other list.
--
-- Parameters:
-- ----------
--     List      is the list_type into which the Sub_List is to be added
--     Position  is the position within List at which Sub_List is added
--     Sub_List  is text which is an external representation of a string
--               a list_type is created from this string and added to list
--
-- Exceptions:
-- ----------
--     Use_Error   is raised if List and Sub_List are not of the same kind
--           and neither of them is Empty; if Sub_List contains a
--           name identical to one in List; if Position is too large;
--           or if List_Text is of invalid format.
--
-- Notes: MIL_STD CAIS 5.4.1.9
-- -----
--
----------------------------------------------------------------
        procedure Splice(List     : in out List_Type;
                         Position : in Position_Count;
                         Sub_List : in List_Type);

-----------------------S P L I C E-----LIST---------------------
--
-- Purpose:
-- -------
--     Inserts a list into a list.  The items in the list to be inserted
--     will becomes items in the resulting list.  Subsequent modifications
--     to the value of List or to the value of Sub_List do not affect the
--     other list.
--
-- Parameters:
-- ----------
--     List      is the list_type into which the Sub_List is to be added
--     Position  is the position within List at which Sub_List is added
--     Sub_List  is an unchanged list_type, a copy of which is added to List
--
-- Exceptions:
-- ----------
--     Use_Error   is raised if List and Sub_List are not of the same kind
--           and neither of them is Empty; if Sub_List contains a
--           name identical to one in List; or if Position is too large.
--
-- Notes: MIL_STD CAIS 5.4.1.9
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.9
        procedure Splice(List     : in out List_Type;
                         Position : in Position_Count;
                         Sub_List : in List_Text);


----------------------M E R G E---------------------------------
--
-- Purpose:
-- -------
--     Returns in result a list which is constructed from the
--     parameters Front and Back.  The lists Front and Back
--     lists are not modified by this procedure.
--
-- Parameters:
-- ----------
--     Front  : is a List_Type which is read but unchanged
--     Back   : is a List_Type which is read but unchanged
--     Result : is a new list_type made up of Front catenated to Back
--
-- Exceptions:
-- ----------
--     Use_Error is raised if one list is named and one is not.
--
-- Notes: MIL_STD CAIS 5.4.1.10
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.10
        procedure Merge(Front  : in List_Type;
                        Back   : in List_Type;
                        Result : in out List_Type);

-----------------S E T _ E X T R A C T--------------------------
--
-- Purpose:
-- -------
--     Extracts a (sub)list from a list.  The return value is a copy of the
--     list subset that starts at the item at Position and has Length items
--     in it.  If there are fewer than Length items in this part of the list,
--     the subset extends to the tail of the list.
--
-- Parameters:
-- ----------
--     List      is the list_type(unchanged) from which the sublist is read
--     Position  is position of the first item to be copied out
--     Length    is the number of items to be copied to the sublist
--     return    is the Text representation of the selected sublist
--
-- Exceptions:
-- ----------
--     Use Error     is raised if Position is larger than the list length
--
-- Notes: MIL_STD CAIS 5.4.1.11
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.11
        function Set_Extract(List     : in List_Type;
                             Position : in Position_Count;
                             Length   : in Positive := Positive'Last) return
            List_Text;

--------------------L E N G T H------OF LIST--------------------
--
-- Purpose:
-- -------
--     Returns a count of the number of items in List. If list
--     is empty, Length returns zero.
--
-- Parameters:
-- ----------
--     List   is the list_type whose items are being counted
--     return the number of items (note list_items count as a single item)
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.12
-- -----
--     None
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.12
        function Length(List : in List_Type) return Count;
                                                          --Mod to MIL_STD CAIS

------------------T E X T _ L E N G T H----OF LIST--------------
--
-- Purpose:
-- -------
--     Returns the length of a string representing a list according
--     to the syntax prescribed in MIL_STD CAIS
--
-- Parameters:
-- ----------
--     List   is the list being examined
--     return the length of the string which is the external text for List
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.13
-- -----
--     None
--
----------------------------------------------------------------
        function Text_Length(List : in List_Type) return Positive;

------------------T E X T - L E N G T H----OF POSITIONAL ITEM---
--
-- Purpose:
-- -------
--     Returns the length of a string representing a list item according
--     to the syntax prescribed in MIL_STD CAIS.  The item is found by
--     position within a list.
--
-- Parameters:
-- ----------
--     List     is the list being examined
--     Position is the position of the item being examined
--     return   the length of the string which is the external text for
--        the item at the designated position
--
-- Exceptions:
-- ----------
--     Use_Error is raised if position is not in range
--
-- Notes: MIL_STD CAIS 5.4.1.13
-- -----
--     None
--
----------------------------------------------------------------
        function Text_Length(List     : in List_Type;
                             Position : in Position_Count) return Natural;

------------------T E X T - L E N G T H----OF NAMED ITEM--------
--
-- Purpose:
-- -------
--     Returns the length of a string representing a list item according
--     to the syntax prescribed in MIL_STD CAIS.  The item is found by
--     searching for the item name.
--
-- Parameters:
-- ----------
--     List     is the list being examined
--     Named    is the name of the item being examined
--     return   the length of the string which is the external text for
--        the item of the designated name
--
-- Exceptions:
-- ----------
--     Use_Error    is raised if this is an unnamed list
--     Search_Error is raised if a matching name is not found
--
-- Notes: MIL_STD CAIS 5.4.1.13
-- -----
--     None
--
----------------------------------------------------------------
        function Text_Length(List  : in List_Type;
                             Named : in Namestring) return Natural;

------------------T E X T - L E N G T H----OF TOKEN_NAMED ITEM-------
--
-- Purpose:
-- -------
--     Returns the length of a string representing a list item according
--     to the syntax prescribed in MIL_STD CAIS.  The item is found by
--     searching for the named token.
--
-- Parameters:
-- ----------
--     List     is the list being examined
--     Named    is the name (in token format) of the item being examined
--     return   the length of the string which is the external text for
--        the item of the designated name
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.13
-- -----
--     None
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.13
        function Text_Length(List  : in List_Type;
                             Named : in Token_Type) return Natural;

----------------------I T E M _ N A M E----PROCEDURE---------------
--
-- Purpose:
-- -------
--     Returns the name of the list item in a named list, specified
--     by position.
--
-- Parameters:
-- ----------
--     List       is the list_type of interest
--     Position   is the position of the item whose name is desired
--     Named      is the Name returned for the item
--
-- Exceptions:
-- ----------
--     Use_Error    is raised if list is positional
--                  or if position exceeds the list length
--
-- Notes: MIL_STD CAIS 5.4.1.14
-- -----
--     Again the CAIS 1.4 semantics are not explicit with respect to
--     null lists. Here, null lists are treated as in Insert, i.e. as
--     either named or positional
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.14
        procedure Item_Name(List     : in List_Type;
                            Position : in Position_Count;
                            Named    : in out Token_Type);

----------------P O S I T I O N _ B Y _ N A M E----STRING-------
--
-- Purpose:
-- -------
--     Returns the Position at which the given Named is located in the
--     List.  It may only be used with named lists.
--
-- Parameters:
-- ----------
--     List   is the list_type of interest
--     Named  is the Name of the item whose position is desired
--     return the position of the named item
--
-- Exceptions:
-- ----------
--     Use_Error      is raised if List is not named
--     Search_Error   is raised if Named is not in the List
--
-- Notes: MIL_STD CAIS 5.4.1.15
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.15
        function Position_By_Name(List  : in List_Type;
                                  Named : in Namestring) return Position_Count;

----------------P O S I T I O N _ B Y _ N A M E----TOKEN_TYPE---
--
-- Purpose:
-- -------
--     Returns the Position at which the given Named is located in the
--     List.  It may only be used with named lists.
--
-- Parameters:
-- ----------
--     List   is the list_type of interest
--     Named  is the Name(in token format) of the item whose position is desired
--     return the position of the named item
--
-- Exceptions:
-- ----------
--     Use_Error      is raised if List is not named
--     Search_Error   is raised if Named is not in the List
--
-- Notes: MIL_STD CAIS 5.4.1.15
-- -----
--
----------------------------------------------------------------
        function Position_By_Name(List  : in List_Type;
                                  Named : in Token_Type) return Position_Count;

---------------------E X T R A C T----NAME --LIS----------------
--
-- Purpose:
-- -------
--     Returns the named List_Element from the list without removing it.
--     Use_Error, Search_Error, indicate unsuccessful extraction.
--
-- Parameters:
-- ----------
--     List      is the named list from which a list_item is to be selected
--     Named     is the name of the item to be copied
--     List_Item is a new list_type consisting of the extacted list
--
-- Exceptions:
-- ----------
--     Search_error     indicates Named item not found
--     Use_Error        indicates an empty or positional list, or that
--                      item is not of list kind.
--
-- Notes: MIL_STD CAIS 5.4.1.16
-- -----
--
-------------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.16
        procedure Extract(List      : in List_Type;
                          Position  : in Position_Count;
                          List_Item : in out List_Type);

---------------------E X T R A C T----TOKEN NAME----LIST--------
--
-- Purpose:
-- -------
--     Returns the named List_Element from the list without removing it.
--     Use_Error, Search_Error, indicate unsuccessful extraction.
--
-- Parameters:
-- ----------
--     List      is the named list from which a list_item is to be selected
--     Named     is the name (in token form) of the item to be copied
--     List_Item is a new list_type consisting of the extacted list
--
-- Exceptions:
-- ----------
--     Search_error     indicates Named item not found
--     Use_Error        indicates an empty or positional list
--
-- Notes: MIL_STD CAIS 5.4.1.16
-- -----
--
-------------------------------------------------------------------
        procedure Extract(List      : in List_Type;
                          Named     : in Namestring;
                          List_Item : in out List_Type);

---------------------E X T R A C T----POSITIONAL ---------------------
--
-- Purpose:
-- -------
--     Returns the nth List_Element from the positional list without
--     removing it.  Use_Error, Search_Error, imply unsuccessful extraction.
--
-- Parameters:
-- ----------
--     List      is the unnamed list from which a list_item is to be selected
--     Position  is the position of the item to be copied
--     List_Item is a new list_type consisting of the extacted list
--
-- Exceptions:
-- ----------
--     Use_Error        indicates an empty or positional list
--                      or indicates Position exceeds list length
--
-- Notes: MIL_STD CAIS 5.4.1.16
-- -----
--
----------------------------------------------------------------
        procedure Extract(List      : in List_Type;
                          Named     : in Token_Type;
                          List_Item : in out List_Type);

--------------------R E P L A C E-----POSITIONAL--------------------
--
-- Purpose:
-- -------
--     Replaces an item in a positional list.  The new item
--     must be of the same item kind as the one being replaced.
--
-- Parameters:
-- ----------
--     List       is the unnamed list of interest
--     List_Item  is the value of list_type which will replace an item in list
--     Position   is the position of a list_item in list which will be replaced
--
-- Exceptions:
-- ----------
--     Use_Error     is raised if position exceeds list length.
--                   or if item kinds do not match.
--
-- Notes: MIL_STD CAIS 5.4.1.17
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.17
        procedure Replace(List      : in out List_Type;
                          List_Item : in List_Type;
                          Position  : in Position_Count);
--------------------R E P L A C E-----NAMED-------------------------
--
-- Purpose:
-- -------
--     Replaces an item in a named list.  The new item
--     must be of the same item kind as the one being replaced.
--
-- Parameters:
-- ----------
--     List       is the named list of interest
--     List_Item  is the value of list_type which will replace an item in list
--     Named      is the name of a list_item in list which will be replaced
--
-- Exceptions:
-- ----------
--     Use_Error        is raised if item kinds do not match.
--     Search_Error     is raised if Named item is not found.
--
-- Notes: MIL_STD CAIS 5.4.1.17
-- -----
--
----------------------------------------------------------------
        procedure Replace(List      : in out List_Type;
                          List_Item : in List_Type;
                          Named     : in Namestring);

--------------------R E P L A C E-----NAMED----TOKEN----------------
--
-- Purpose:
-- -------
--     Replaces an item in a named list.  The new item
--     must be of the same item kind as the one being replaced.
--
-- Parameters:
-- ----------
--     List       is the named list of interest
--     List_Item  is the value of list_type which will replace an item in list
--     Named      is the name (in token format) of a list_item in list which
--                will be replaced
--
-- Exceptions:
-- ----------
--     Use_Error        is raised if item kinds do not match.
--     Search_Error     is raised if Named item is not found.
--
-- Notes: MIL_STD CAIS 5.4.1.17
-- -----
--
----------------------------------------------------------------
        procedure Replace(List      : in out List_Type;
                          List_Item : in List_Type;
                          Named     : in Token_Type);


-----------------I N S E R T----POSITIONAL----------------------
--
-- Purpose:
-- -------
--     Inserts a list item into a positional list.  Use_Error
--     or Search_Error may be raised indicating list item has
--     not been inserted.
--
-- Parameters:
-- ----------
--     List       is the list_type of interest
--     List_Item  is the value to be added to list as a list_item
--     Position   is the position in list after which List_Item will be placed
--
-- Exceptions:
-- ----------
--     Use_Error     is raised if this is a named list.
--                   or if position exceeds size of list
--
-- Notes: MIL_STD CAIS 5.4.1.18
-- -----
--
----------------------------------------------------------------
   -- MIL_STD CAIS 5.4.1.18
        procedure Insert(List      : in out List_Type;
                         List_Item : in List_Type;
                         Position  : in Count);

-----------------I N S E R T----NAMED---STRING------------------
--
-- Purpose:
-- -------
--     Inserts a list item into a named list.  Use_Error
--     or Search_Error may be raised indicating list item has
--     not been inserted.
--
-- Parameters:
-- ----------
--     List       is the list_type of interest
--     List_Item  is the value to be added to list as a list_item
--     Named      is the string value of the name to be used for List-Item
--     Position   is the position in list after which List_Item will be placed
--
-- Exceptions:
-- ----------
--     Use_Error     is raised if this is an unnamed list.
--                   or if position exceeds size of list
--
-- Notes: MIL_STD CAIS 5.4.1.18
-- -----
--
----------------------------------------------------------------
        procedure Insert(List      : in out List_Type;
                         List_Item : in List_Type;
                         Named     : in Namestring;
                         Position  : in Count);

-----------------I N S E R T----NAMED---TOKEN-------------------
--
-- Purpose:
-- -------
--     Inserts a list item into a named list.  Use_Error
--     or Search_Error may be raised indicating list item has
--     not been inserted.
--
-- Parameters:
-- ----------
--     List       is the list_type of interest
--     List_Item  is the value to be added to list as a list_item
--     Named      is the name value (in token form) to be used for List-Item
--     Position   is the position in list after which List_Item will be placed
--
-- Exceptions:
-- ----------
--     Use_Error     is raised if this is an unnamed list.
--                   or if position exceeds size of list
--
-- Notes: MIL_STD CAIS 5.4.1.18
-- -----
--
----------------------------------------------------------------
        procedure Insert(List      : in out List_Type;
                         List_Item : in List_Type;
                         Named     : in Token_Type;
                         Position  : in Count);

-----------P O S I T I O N _ B Y _ V A L U E--------------------
--
-- Purpose:
-- -------
--     Returns the position at which the next list_type item of the given
--     value is located. the search begins at the Start_Position and ends
--     when either an item of Value is found, the last item of the list
--     has been examined, or the item at the End_Position has been
--     examined, whichever comes first.
--
-- Parameters:
-- ----------
--     List           is the list_type of interest
--     Value          is the value of list_type being looked for
--     Start_Position is the position of the starting item in the search
--     End_Position   is the position of the ending   item in the search
--     return         the position of an item whose value matches
--
-- Exceptions:
-- ----------
--     Use_Error     raised if Start<End or Start > length of list
--     Search_Error  raised if Value not found in specified range
--
-- Notes: MIL_STD CAIS 5.4.1.19
-- -----
--
----------------------------------------------------------------
  --MIL_STD CAIS 5.4.1.19
        function Position_By_Value(List           : in List_Type;
                                   Value          : in List_Type;
                                   Start_Position : in Position_Count :=
                                       Position_Count'First;
                                   End_Position   : in Position_Count :=
                                       Position_Count'Last) return
            Position_Count;

--------------------------------------------------------------------------
--   S E P A R A T E     P A C K A G E   I D E N T I F I E R _ I T E M
--MIL_STD CAIS 5.4.1.20
--------------------------------------------------------------------------
  --MIL_STD CAIS 5.4.1.20
        package Identifier_Items is
          -- MIL STD CAIS 5.4.1.23.1
            procedure To_Token(Identifier : in Namestring;
                               Token      : in out Token_Type);

          -- MIL_STD CAIS 5.4.1.20.2
            function To_Text(List_Item : in Token_Type) return Namestring;

          -- MIL_STD CAIS 5.4.1.20.3
            function Is_Equal(Token1 : in Token_Type;
                              Token2 : in Token_Type) return Boolean;

          -- MIL STD CAIS 5.4.1.20.4
            procedure Extract(List     : in List_Type;
                              Position : in Position_Count;
                              Token    : in out Token_Type);

            procedure Extract(List  : in List_Type;
                              Named : in Namestring;
                              Token : in out Token_Type);

            procedure Extract(List  : in List_Type;
                              Named : in Token_Type;
                              Token : in out Token_Type);

          -- MIL_STD CAIS 5.4.1.20.5
            procedure Replace(List      : in out List_Type;
                              List_Item : in Token_Type;
                              Position  : in Position_Count);

            procedure Replace(List      : in out List_Type;
                              List_Item : in Token_Type;
                              Named     : in Namestring);

            procedure Replace(List      : in out List_Type;
                              List_Item : in Token_Type;
                              Named     : in Token_Type);

          -- MIL_STD CAIS 5.4.1.20.6
            procedure Insert(List      : in out List_Type;
                             List_Item : in Token_Type;
                             Position  : in Count);

            procedure Insert(List      : in out List_Type;
                             List_Item : in Token_Type;
                             Named     : in Namestring;
                             Position  : in Count);

            procedure Insert(List      : in out List_Type;
                             List_Item : in Token_Type;
                             Named     : in Token_Type;
                             Position  : in Count);

          --MIL_STD CAIS 5.4.1.20.7
            function Position_By_Value(List           : in List_Type;
                                       Value          : in Token_Type;
                                       Start_Position : in Position_Count :=
                                           Position_Count'First;
                                       End_Position   : in Position_Count :=
                                           Position_Count'Last) return
                Position_Count;

        end Identifier_Items;

--------------------------------------------------------------------------
--   S E P A R A T E     P A C K A G E   S T R I N G _ I T E M
--MIL_STD CAIS 5.4.1.23
--------------------------------------------------------------------------
  --MIL_STD CAIS 5.4.1.23
        package String_Items is
          -- MIL STD CAIS 5.4.1.23.1
            function Extract(List     : in List_Type;
                             Position : in Position_Count) return String;
            function Extract(List  : in List_Type;
                             Named : in Namestring) return String;
            function Extract(List  : in List_Type;
                             Named : in Token_Type) return String;

          -- MIL_STD CAIS 5.4.1.23.2
            procedure Replace(List      : in out List_Type;
                              List_Item : in String;
                              Position  : in Position_Count);
            procedure Replace(List      : in out List_Type;
                              List_Item : in String;
                              Named     : in Namestring);
            procedure Replace(List      : in out List_Type;
                              List_Item : in String;
                              Named     : in Token_Type);

          -- MIL_STD CAIS 5.4.1.23.3
            procedure Insert(List      : in out List_Type;
                             List_Item : in String;
                             Position  : in Count);
            procedure Insert(List      : in out List_Type;
                             List_Item : in String;
                             Named     : in Namestring;
                             Position  : in Count);
            procedure Insert(List      : in out List_Type;
                             List_Item : in String;
                             Named     : in Token_Type;
                             Position  : in Count);

          --MIL_STD CAIS 5.4.1.23.4
            function Position_By_Value(List           : in List_Type;
                                       Value          : in String;
                                       Start_Position : in Position_Count :=
                                           Position_Count'First;
                                       End_Position   : in Position_Count :=
                                           Position_Count'Last) return
                Position_Count;

        end String_Items;

        procedure Dump(List : in List_Type);
    private

        type String_Of_Any_Length(Size : Natural) is
            record
                Value : String(1 .. Size);
            end record;
        type Token_Type is access String_Of_Any_Length;

        type Item_Descriptor;
        type List_Type is access Item_Descriptor;
        type Item_Descriptor is
            record
                Kind      : Item_Kind;
                Name      : Token_Type;
                Element   : Token_Type;
                List      : List_Type;
                Next_Item : List_Type;
            end record;

        Empty_List : constant List_Type := null;

---------------------------------------------------------------------------
    end List_Utilities;
                      --  END OF PACKAGE SPEC
---------------------------------------------------------------------------
----------------------------------------------------------------------
--             C A I S _ N O D E _ M A N A G E M E N T
--
--  Function:
--  --------
--      This package defines the general primitives for manipulating,
--      copying, renaming and deleting nodes and their relationships.
--
--  Usage:
--  -----
--      The operations defined in this package are applicable to all
--      nodes, relationships, and attributes, except where explicitly
--      stated otherwise.  These operations DO NOT include the CREATION
--      of nodes.  The creation of structural nodes is performed by
--      the Create_Node procedures of package CAIS_Structural_Nodes
--      (MIL-STD-CAIS Section 5.1.5), the creation of nodes for processes
--      is performed by Invoke_Process and Spawn_Process of package
--      CAIS_Process_Control (MIL-STD-CAIS Section 5.1.5), and the creation
--      of nodes for files os performed by the Create procedures of the
--      CAIS Input/Output packages (MIL-STD-CAIS Section 5.3).
--
--      There are three CAIS interfaces for manipulating node handles;
--      Open opens a node handle, Close closes the node handle, and
--      Change_Intent alters the specification of the intention of node
--      handle usage.  These interfaces perform access synchronization
--      in accordance with an intent specified by the parameter "Intent".
--
--  Example:
--  -------
--      TBS
--
--  Notes:
--  -----
--      This is a version of the package CAIS_NODE_MANAGEMENT,
--      specified in MIL-STD-CAIS section 5.1.2; all references to
--      the CAIS specification refer to the MIL-STD-CAIS specification
--      dated 31 January 1985.
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------

    package Node_Management is

        use Node_Definitions;
        use List_Utilities;
        use Pragmatics;


    -- The following type declarations are from CAIS section 5.1.2.25
        type Node_Iterator is limited private;
        subtype Relationship_Key_Pattern is Relationship_Key;
        subtype Relation_Name_Pattern is Relation_Name;


------------------------       O P E N       ------------------------
--
--  Purpose:
--  -------
--    These procedure return an open node handle in "Node" to the
--    node identified by the pathname "Name" or "Base"/"Key"/"Relation",
--    respectively.
--
--  Parameters:
--  ----------
--    Node      - a node handle, initially closed, to be opened to the
--                identified node
--    Name      - the pathname identifying the node to be opened
--    Base      - open node handle to a base node for identification
--    Key       - the relationship key for node identification
--    Relation  - the relation name for node identification
--    Intent    - the intent of subsequent operations on the node; the
--                actual parameter takes the form of an array aggregate
--    Time_Limit - specifies time limit for the delay on waiting for the
--                unlocking of a node in accordance with the desired intent
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the pathname specified by "Name" is
--                        syntactically illegal or if any traversed node
--                        in the path specified by pathname is unobtainable,
--                        inaccessible, or non-existant, or if the relationship
--                        specified by "Relation" and "Key" or by the last
--                        path element of "Name" does not exist.  Name_Error
--                        is also raised if the node to which a handle is to
--                        be opened is inaccessible or unobtainable and the
--                        given "Intent" includes any intent other
--                        than "Existence".
--    Use_Error         - is raised if the specified intent is an empty array.
--    Status_Error      - is raised if the Node_Handle "Node" is already
--                        open prior to the call on Open or if Base is not
--                        an open node handle.
--    Lock_Error        - is raised if the Open operation is delayed beyond
--                        the specified time limit due to the existance of
--                        locks in conflict with the specified Intent.  This
--                        includes any delays caused by locks on nodes
--                        traversed on the path specified by the pathname
--                        "Name", or locks on the node identified by "Base",
--                        preventing the reading of relationships emanating
--                        from these nodes.
--    Intent_Violation  - is raised if "Base" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to traverse
--                        the path specified by "Name" or by "Base", "Key",
--                        and "Relation" or to obtain access to the node
--                        consistent with the specified intent.
--                        Access_Violation is raised only if the conditions
--                        for Name_Error are not present.
--    Security_Violation -is raised if the attempt to obtain access to the
--                        node with the specified intent represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.1
--  -----
--
---------------------------------------------------------------------
        procedure Open(Node       : in out Node_Type;
                       Name       : Name_String;
                       Intent     : Intention := (1 => Read);
                       Time_Limit : Duration := No_Delay);

        procedure Open(Node       : in out Node_Type;
                       Base       : Node_Type;
                       Key        : Relationship_Key;
                       Relation   : Relation_Name := Default_Relation;
                       Intent     : Intention := (1 => Read);
                       Time_Limit : Duration := No_Delay);

----------------------      C L O S E          ----------------------
--
--  Purpose:
--  -------
--    This procedure severs any association between the node handle
--    "Node" and the node, and releases any associated locks on the
--    node imposed by the intent of the node handle "Node".  Closing
--    an alReady closed node handle has no effect.
--
--  Parameters:
--  ----------
--    Node - node handle, initially open, to be closed.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--     CAIS 5.1.2.2
--
---------------------------------------------------------------------
        procedure Close(Node : in out Node_Type);

----------------------  C H A N G E _ I N T E N T -------------------
--
--  Purpose:
--  -------
--    This procedure changes the intention regarding the use of the node
--    handle "Node".  It is semantically equivalent to closing the node
--    handle an reopening the node handle to the same node with the
--    "Intent" and "Time_Limit" paramters of Change_Intent, except that
--    Change_Intent guarantees to return an open node handle that refers
--    to the same node as the node handle input in "Node".  (See the issue
--    explained in the nore below).
--
--  Parameters:
--  ----------
--    Node      - an open node handle
--    Intent    - the intent of subsequent operations on the node; the
--                actual parameter takes the form of an array aggregate.
--    Time_Limit- specifies the time limit for the delay on waiting on
--                waiting for the unlocking of a node in accordance with
--                the desired intent.
--
--  Exceptions:
--  ----------
--    Name_Error        - is raised if the node handle "Node" refers to
--                        an unobtainable node and "Intent" contains any
--                        intent specification other than "Existence".
--    Status_Error      - is raised if the node handle "Node" is not an
--                        open node handle.
--    Lock_Error        - is raised if the operation is delayed beyond the
--                        specified time limit due to the existence of locks
--                        on the node in conflict with the specified "Intent".
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--                        access to the node consistent with the specified
--                        intent.  Access_Violation is raised only of the
--                        condition for Name_Error is not present.
--    Security_Violation- is raised if an attempt to obtain access consistent
--                        with the intention "Intent" to the node specified
--                        by "Node" represents a violation of mandatory
--                        access controls for the CAIS.  Security_Violation
--                        is raised only if the conditions for other exceptions
--                        are not present.
--
--  Notes:  CAIS 5.1.2.3
--  -----
--    Use of the sequence of a Close and an Open operation instead of a
--    Change_Intent operation cannot guarantee that the same node is opened,
--    since relationships, and therefore the node identification, may have
--    changed since the previous Open on the Node.
--
---------------------------------------------------------------------
    -- CAIS 5.1.2.3
        procedure Change_Intent(Node       : in out Node_Type;
                                Intent     : Intention;
                                Time_Limit : Duration := No_Delay);

----------------------     I S _ O P E N       ----------------------
--
--  Purpose:
--  -------
--    This function returns True if the node handle "Node" is open;
--    otherwise, it returns FALSE.
--
--  Parameters:
--  ----------
--    Node - node handle
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--     CAIS 5.1.2.4
--
---------------------------------------------------------------------
        function Is_Open(Node : Node_Type) return Boolean;

----------------------     I N T E N T _ O F   ----------------------
--
--  Purpose:
--  -------
--    This function returns the intent with which the node handle
--    Node is open.
--
--  Parameters:
--  ----------
--    Node   - an open node handle.
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error - if the node handle is not open.
--
--  Notes:
--  -----
--   CAIS 5.1.2.5
--
---------------------------------------------------------------------
        function Intent_Of(Node : Node_Type) return Intention;

----------------------        K I N D          ----------------------
--
--  Purpose:
--  -------
--    This function returns the kind of a node, either FILE, PROCESS,
--    or STRUCTURAL.
--
--  Parameters:
--  ----------
--    Node  - open node handle
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error  - if the node handle is not open.
--
--  Notes:
--  -----
--   CAIS 5.1.2.6
--
---------------------------------------------------------------------
        function Kind(Node : Node_Type) return Node_Kind;

------------------------ P R I M A R Y _ N A M E---------------------
--
--  Purpose:
--  -------
--    This function returns the unique primary name of the node identified
--    by NODE.
--
--  Parameters:
--  ----------
--    Node      - an open node handle identifying the node of interest
--
--  Exceptions:
--  ----------
--    Name_Error        - is raised if any node traversed on the primary
--                        path is inaccessible.
--    Status_Error      - is raised if the Node_Handle "Node" is not open.
--    Lock_Error        - is raised if access consistent with intent
--                        Read_Relationships to any node traversed on the
--                        primary path cannot be obtained due to an existing
--                        lock on the node.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to traverse
--                        the node's primary path.  Access_Violation is raised
--              only if the conditions for Name_Error are not present.
--
--  Notes:   CAIS 5.1.2.7
--  -----
--
---------------------------------------------------------------------
        function Primary_Name(Node : in Node_Type) return Name_String;

------------------------ P R I M A R Y _ K E Y ----------------------
--
--  Purpose:
--  -------
--    This function returns the relationship key of the last path
--    element of the unique primary name of the node identified by NODE.
--
--  Parameters:
--  ----------
--    Node      - an open node handle identifying the node of interest
--
--  Exceptions:
--  ----------
--    Name_Error        - is raised if the parent node of the node identified
--                        by "Node" is inaccessible.
--    Status_Error      - is raised if the Node_Handle "Node" is not open.
--    Lock_Error        - is raised if the parent node is locked against
--                        Read_Relationships.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--              access to the node's parent consistent with intent
--              Read_Relationships.  Access_Violation is raised
--              only if the conditions for Name_Error are not present.
--
--  Notes:   CAIS 5.1.2.8
--  -----
--
---------------------------------------------------------------------
        function Primary_Key(Node : in Node_Type) return Relationship_Key;

------------------- P R I M A R Y _ R E L A T I O N ------------------
--
--  Purpose:
--  -------
--    This function returns the relation name of the last path
--    element of the unique primary name of the node identified by NODE.
--
--  Parameters:
--  ----------
--    Node      - an open node handle identifying the node of interest
--
--  Exceptions:
--  ----------
--    Name_Error        - is raised if the parent node of the node identified
--                        by "Node" is inaccessible.
--    Status_Error      - is raised if the Node_Handle "Node" is not open.
--    Lock_Error        - is raised if the parent node is locked against
--                        Read_Relationships.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--              access to the node's parent consistent with intent
--              Read_Relationships.  Access_Violation is raised
--              only if the conditions for Name_Error are not present.
--
--  Notes:   CAIS 5.1.2.9
--  -----
--
---------------------------------------------------------------------
        function Primary_Relation(Node : in Node_Type) return Relation_Name;

----------------------    P A T H _ K E Y      ----------------------
--
--  Purpose:
--  -------
--    This function returns the relationship key of the relationship
--    corresponding to the last path element of the pathname used
--    in opening this node handle.  Since a path element is a string,
--    the relationship key is returned even if the relationship has
--    been deleted.
--
--  Parameters:
--  ----------
--    Node      - an open node handle
--
--  Exceptions:
--  ----------
--    Status_Error      - raised if the node handle "Node" is not open.
--
--  Notes:   CAIS 5.1.2.10
--  -----
--
---------------------------------------------------------------------
        function Path_Key(Node : Node_Type) return Relationship_Key;

----------------------     P A T H _ R E L A T I O N ----------------
--
--  Purpose:
--  -------
--    This function returns the relation name of the relationship
--    corresponding to the last path element of the pathname used
--    in opening this node handle.
--    The relationship key is returned even if the relationship has
--    been deleted.
--
--  Parameters:
--  ----------
--    Node      - an open node handle
--
--  Exceptions:
--  ----------
--    Status_Error      - raised if the node handle "Node" is not open.
--
--  Notes:   CAIS 5.1.2.11
--  -----
--
---------------------------------------------------------------------
        function Path_Relation(Node : Node_Type) return Relation_Name;

----------------------    B A S E _ P A T H    ----------------------
--
--  Purpose:
--  -------
--    This function returns the pathname obtained by deleting the last
--    path element from "Name".  It does not establish whether the
--    pathname identifies an existing node; only the syntactic properties
--    of the pathname are examined.  This function also checks the
--    legality of the pathname "Name".
--
--  Parameters:
--  ----------
--    Name      - a pathname (not necessarily identifying a node).
--
--  Exceptions:
--  ----------
--    Name_Error  - raised if Name is a syntactically illegal pathname.
--
--  Notes: CAIS 5.1.2.12
--  -----
--
---------------------------------------------------------------------
        function Base_Path(Name : Name_String) return Name_String;

----------------------   L A S T _ R E L A T I O N  -----------------
--
--  Purpose:
--  -------
--    This function returns the name of the relation of the last
--    path element of the pathname "Name".  It does not establish
--    whether the pathname identifies an existing node; only the
--    syntactic properties of the pathname are examined.  This function
--    also checks the syntactic legality of the pathname "Name".
--
--  Parameters:
--  ----------
--    Name   - a pathname, not necessarily identifying a node.
--
--  Exceptions:
--  ----------
--    Name_Error   - if name is syntactically illegal.
--
--  Notes:   CAIS 5.1.2.13
--  -----
--
---------------------------------------------------------------------
        function Last_Relation(Name : Name_String) return Relation_Name;

------------------------     L A S T _ K E Y     --------------------
--
--  Purpose:
--  -------
--    This function returns the name of the relationship key of the last
--    path element of the pathname "Name".  It does not establish
--    whether the pathname identifies an existing node; only the
--    syntactic properties of the pathname are examined.  This function
--    also checks the syntactic legality of the pathname "Name".
--
--  Parameters:
--  ----------
--    Name   - a pathname, not necessarily identifying a node.
--
--  Exceptions:
--  ----------
--    Name_Error   - if name is syntactically illegal.
--
--  Notes:   CAIS 5.1.2.14
--  -----
--
---------------------------------------------------------------------

        function Last_Key(Name : Name_String) return Relationship_Key;

----------------------   I S _ O B T A I N A B L E  -----------------
--
--  Purpose:
--  -------
--    This function returns False if the node identified by "Node"
--    is unobtainable or inaccessible.  It returns True otherwise.
--
--  Parameters:
--  ----------
--    Node - an open node handle identifying the node
--
--  Exceptions:
--  ----------
--    Status_Error  - raised if "Node" is not an open node handle.
--
--  Notes:  CAIS 5.1.2.15
--  -----
--
---------------------------------------------------------------------
        function Is_Obtainable(Node : Node_Type) return Boolean;

----------------------     I S _ S A M E      -----------------------
--
--  Purpose:
--  -------
--    This function returns True if the nodes identified by its
--    arguments are the same node; otherwise, it returns FALSE.
--
--  Parameters:
--  ----------
--    Node1   - open node handle to a node
--    Node2   - open node handle to a node
--
--  Exceptions:
--  ----------
--    Status_Error  is raised if either of the node handles is not open.
--
--  Notes:
--  -----
--      This is a version of the function Is_Same,
--      specified in MIL-STD-CAIS 5.1.2.16; all references to
--      the CAIS specification refer to the CAIS  specification
--      dated 31 January 1985.
--
---------------------------------------------------------------------
        function Is_Same(Node1 : Node_Type;
                         Node2 : Node_Type) return Boolean;
----------------------------------------------------------------------
--        A D D I T I O N A L   I N T E R F A C E
----------------------------------------------------------------------
        function Is_Same(Name1 : Name_String;
                         Name2 : Name_String) return Boolean;

------------------------  G E T _ P A R E N T  ----------------------
--
--  Purpose:
--  -------
--    This procedure returns an open node handle in "Parent" to the parent
--    of the node identified by the open node handle "Node".  The intent
--    under which the node handle "Parent" is opened is specified by "Intent".
--    A call on Get_Parent is equivalent to a call:
--        Open(Parent, Node, "", Parent, Intent, Time_Limit);
--
--  Parameters:
--  ----------
--    Parent    - a node handle, initially closed, to be opened to the
--                parent node
--    Node      - an open handle identifying the node
--    Intent    - the intent of subsequent operations on the node "Parent";
--                the actual parameter takes the form of an array aggregate
--    Time_Limit - specifies time limit for the delay on waiting for the
--                unlocking of the parent node in accordance with the desired
--        - intent
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the node identified by "Node" is a top
--              level node or if its parent node is inaccessible.
--    Use_Error         - is raised if the specified intent is an empty array.
--    Status_Error      - is raised if the Node_Handle "Parent" is already
--                        open prior to the call on or if "Node" is not
--                        an open node handle.
--    Lock_Error        - is raised if the opening of the Parent node is
--              delayed beyond the specified time limit due to
--              the existance of locks in conflict with the
--              specified Intent.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--                        access to the parent node with the specified intent.
--                        Access_Violation is raised only if the conditions
--                        for Name_Error are not present.
--    Security_Violation -is raised if the attempt to obtain access to the
--                        parent node with the specified intent represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.17
--  -----
--
---------------------------------------------------------------------
        procedure Get_Parent(Parent     : in out Node_Type;
                             Node       : in Node_Type;
                             Intent     : Intention := (1 => Read);
                             Time_Limit : Duration := No_Delay);

------------------------       C O P Y       ------------------------
--
--  Purpose:
--  -------
--    These procedures copy a file or structural node THAT DOES NOT HAVE
--    EMANATING PRIMARY RELATIONSHIPS.  The node copied is identified by
--    the open node handle "From" and is copied to a newly created node.
--    The new node is identified by the combination of the To_Base, To_Key,
--    and To_Relation parameters.  The newly created node is of the same
--    kind as the node identified by From. If the node is a file node, its
--    contents are also copied, i.e., a new copied file is created.  Any
--    secondary relationships emanating from the original node, excepting
--    the relation of the predefined relation parent(which is appropriately
--    adjusted), are recreated in the copy.  If the target of the original
--    nodes relationship IS THE NODE ITSELF, THEN THE COPY HAS AN ANALOGOUS
--    RELATION TO ITSELF.  Any other secondary relationship whose target is
--    the original node is unaffected.  All attributes of the From node are
--    also copied.  Regardless of any locks on the node identified by From,
--    the newly creasted node is unlucked.
--
--  Parameters:
--  ----------
--    From      - an open node handle to the node to be copied.
--    To_Base   - open node handle to a base node for identification of the
--          node to be created.
--    To_Key    - the relationship key for identification of the node to be
--              - created.
--    To_Relation  - the relation name for identification of the node to be
--                created.
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the new node identification is illegal
--                        or if a node already exists with the identification
--                        given for the new node.
--    Use_Error         - is raised if the origianl node is not a file or
--              structural node or if any primary relationships
--              emanate from the original node.  Use_Error is also
--              raised if the To_Relation is the name of a predefined
--              relation that cannot be modified or created by the
--              user.
--    Status_Error      - is raised if the Node_Handles From and To_Base are
--              not both open.
--    Intent_Violation  - is raised if "From" was not opened with an intent
--                        establishing the right to read contents, attributes
--              and relationships, or if To_Base was not opened with
--              the right to append relationships. Intent_Violation
--              is not raised if the conditions for name error are
--              present.
--    Security_Violation -is raised if the attempt to obtain access to the
--                        node with the specified intent represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.18
--  -----
--
---------------------------------------------------------------------

        procedure Copy_Node(From        : Node_Type;
                            To_Base     : in out Node_Type;
                            To_Key      : Relationship_Key;
                            To_Relation : Relation_Name := Default_Relation);

        procedure Copy_Node(From : in Node_Type;
                            To   : in Name_String);

------------------       C O P Y _ T R E E       ------------------------
--
--  Purpose:
--  -------
--    These procedures copy a tree of file or structural nodes formed by the
--    primary relationships emanating from the node identified by the open node
--    handle From.  Primary relationships are recreated between corresponding
--    copied nodes.  The root node of the newly created tree corresponding to
--    the From node is the node identified by the combination of the To_Base,
--    To_Key, and To_Relation parameters.  If an exception is raised by the
--    procedure none of the nodes are copied.  Secondary relationships,
--    attributes, and node contents are copied as described for Copy_Node with
--    the following additional rules: secondary relationships between two nodes
--    which are both copied are recreated between the two copies.  Secondary
--    relationships emanating from a node which is copied, but which refer to
--    nodes outside the tree being copied, are copied so that they emanate from
--    the copy, but still refer to the original target node.  Secondary
--    relationships emanating from a node which is not copied, but which refer
--    to nodes inside the tree being copied, are unaffected.  If the node
--    identified by To_Base is part of the tree being copied, then the copy of
--    the node identified by From will not be copied recursively.
--
--  Parameters:
--  ----------
--    From      - an open node handle to the root node of the tree to be copied.
--    To_Base   - open node handle to a base node for identification of the
--          node to be created as root of the new tree.
--    To_Key    - the relationship key for identification of the node to be
--              - created as root of the new tree.
--    To_Relation  - the relation name for identification of the node to be
--                created as root of the new tree.
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the new node identification is illegal
--                        or if a node already exists with the identification
--                        given for the new node to be created as a copy of
--              the node identified by From.
--    Use_Error         - is raised if the origianl node is not a file or
--              structural node.  Use_Error is also raised if the
--              To_Relation is the name of a predefined relation
--              that cannot be modified or created by the user.
--    Status_Error      - is raised if the Node_Handles From and To_Base are
--              not both open.
--    Lock_Error    - is raised if any node to be copied except the node
--              identified by From is locked against read access to
--              attributes, relationships, or contents.
--    Intent_Violation  - is raised if "From" was not opened with an intent
--                        establishing the right to read contents, attributes
--              and relationships, or if To_Base was not opened with
--              the right to append relationships. Intent_Violation
--              is not raised if the conditions for name error are
--              present.
--    Access_Violation     - is raised if the current process' discretionary
--              access control rights are insufficient to obtain
--              access to each node to be copied with intent Read.
--              Access_Violation is not raised if conditions for
--              Name_Error are present.
--    Security_Violation -is raised if the operations represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.19
--  -----
--
---------------------------------------------------------------------

        procedure Copy_Tree(From        : Node_Type;
                            To_Base     : in out Node_Type;
                            To_Key      : Relationship_Key;
                            To_Relation : Relation_Name := Default_Relation);

        procedure Copy_Tree(From : in Node_Type;
                            To   : in Name_String);


------------------------     R E N A M E     ------------------------
--
--  Purpose:
--  -------
--    These procedures rename a file or a structural node.  They delete
--    the Primary relationship to the node identified by "Node" and install
--    a new primary relationship to the node, emanating from the node
--    identified by "New_Base", with key and relation given by the New_KEy and
--    New_Relation parameters.  The parent relationship is changed accordingly.
--    This the unique primary path name of the node.  Existing secondary
--    relationships with the renamed node as target track the renaming, i.e.,
--    they have the renamed node as target.
--
--  Parameters:
--  ----------
--    Node      - an opened node handle to the node to be renamed.
--    New_Base  - open node handle to a base node from which the new primary
--          relationship to the renamed node emanates.
--    New_Key   - the relationship key for the new primary relationship
--    New_Relation  - the relation name for the new primary relationship
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the new node identification is illegal
--              or if a node already exists with the identification
--              given for the new node.
--    Use_Error         - is raised if the node identified by "Node" is not a
--              file or structural node or if the renaming cannot be
--              accomplished while still maintaining acircularity of
--              primary relationships (eg. if the new parent node
--              would be the renamed node).  Use Error is also raised
--              if New_Relation is the name of a predefined relation
--              that cannot be modified or createdby the user or if
--              the primary relationship to be deleted belongs to a
--              predefined relation that cannot be modified by the
--              user.
--    Status_Error      - is raised if the Node_Handle "Node" and "New_Base"
--                        are not open.
--    Lock_Error        - is raised if access with intent Write_Relationships,
--                        to the parent of the node to be renamed cannot be
--              obtained to due to an existing lock on the node.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to write relationships or
--              if "New_Base" was not opened with an intent
--                        establishing the right to append relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--                        access to the parent of the node to be renamed
--                        with intent Write_Relationships and the conditions
--              for Name_Error are not present.
--    Security_Violation -is raised if the operation represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.20
--  -----
--
---------------------------------------------------------------------

        procedure Rename(Node         : in out Node_Type;
                         New_Base     : in out Node_Type;
                         New_Key      : Relationship_Key;
                         New_Relation : Relation_Name := Default_Relation);

        procedure Rename(Node     : in out Node_Type;
                         New_Name : Name_String);

----------------------   D E L E T E _ N O D E ----------------------
--
--  Purpose:
--  -------
--    This procedure deletes the primary relationship to a node
--    identified by Node.  The node becomes unobtainable.  The node
--    handle Node is closed.  If the node is a process node and the
--    process is not yet terminated (see Section 5.2 of MIL-STD-CAIS),
--    Delete_Node aborts the process.
--
--  Parameters:
--  ----------
--    Node  - an open node handle to the node which is the target of
--            the primary relationship to be deleted.
--
--  Exceptions:
--  ----------
--    (all defined in Node_Definitions)
--    Name_Error          - if parent node of Node is inaccessable
--    Use_Error           - if any primary Relationships emanate from Node
--    Status_Error        - if Node is not open
--    Lock_Error          - if access, with intent Write_Relationships,
--                          to the parent of the node to be deleted
--                          cannot be obtained due to an existing lock
--                          on the node.
--    Intent_Violation    - if the node handle Node was not opened with
--                          an intent including Exclusive_Write and
--                          Read_Relationships.
--    Access_Violation    - if the current process does not have sufficient
--                          discretionary access control rights to obtain
--                          access to the parent of the node to be deleted
--                          with intent Write_Relationships and the
--                          conditions for Name_Error are not present.
--    Security_Violation  - if the operation represents a violation of
--                          mandatory access controls.  Security_Violation
--                          is raised only if the conditions for other
--                          exceptions are not present.
--
--  Notes:
--  -----
--    MIL-STD-CAIS 5.1.2.21
--     Locking support will have to be added here...
---------------------------------------------------------------------
        procedure Delete_Node(Node : in out Node_Type);

        procedure Delete_Node(Name : Name_String);

----------------------   D E L E T E _ T R E E ----------------------
--
--  Purpose:
--  -------
--    This procedure effectively performs the Delete_Node operation for
--    a specified node and recursively applies Delete_Tree to all nodes
--    reachable by a unique primary pathname from the designated node.
--    The nodes whose primary relationships are to be deleted are opened
--    with intent Exclusive_Write, thus locking them for other operations.
--    The order in which the deletions of primary relationships is performed
--    is not specified.  If the Delete_Tree operation raises an exception,
--    none of the primary relationships is deleted.
--
--  Parameters:
--  ----------
--    Node  - an open node handle to the node at the root of the tree
--            whose primary relationships are to be deleted.
--
--  Exceptions:
--  ----------
--    (all defined in Node_Definitions)
--    Name_Error          - if parent node of Node or any of the target nodes of
--                primary relationships to be deleted are inaccessable
--    Use_Error           - if the primary Relationship of Node belongs to a
--                predefined relation that cannot be modified by the
--                user.
--    Status_Error        - if Node is not open
--    Lock_Error          - if access, with intent Write_Relationships,
--                          to the parent of the "Node" cannot be obtained due
--                to an existing lock or if a node handle identifying
--                any node whose unique primary path traverses the
--                node identified by Node cannot be opened with intent
--                Exclisive_Write.
--    Intent_Violation    - if the node handle Node was not opened with
--                          an intent including Exclusive_Write and
--                          Read_Relationships.
--    Access_Violation    - if the current process does not have sufficient
--                          discretionary access control rights to obtain
--                          access to the parent of the node specified by Node
--                          with intent Write_Relationships or to obtain
--                access to any target node of a primary relationship
--                to be deleted with the intent Exclusive_Write and
--                the conditions for Name_Error are not present.
--    Security_Violation  - if the operation represents a violation of
--                          mandatory access controls.  Security_Violation
--                          is raised only if the conditions for other
--                          exceptions are not present.
--
--  Notes:
--  -----
--    MIL-STD-CAIS 5.1.2.23
--     Locking support will have to be added here...
---------------------------------------------------------------------
        procedure Delete_Tree(Node : in out Node_Type);

        procedure Delete_Tree(Name : Name_String);

-------------------------   L I N K   -------------------------------
--
--  Purpose:
--  -------
--    This procedure creates a secondary relationship between two existing
--    The procedure takes a node handle "Node" on the target node, a
--    node handle "New_Base" on the source node, and an explicit key
--    "New_Key" and a relation name "New_Relation" for the relationship
--    to be established from "New_Base" to "Node".
--
--  Parameters:
--  ----------
--    Node        - open node handle to the node to which the new
--                  secondary relationship points.
--    New_Base    - an open node handle to the base node from which the
--                  new secondary relationship to the node emanates.
--    New_Key     - the relationship key for the new secondary relationship
--    New_Relation - the relation name for the new secondary relationship
--
--  Exceptions:
--  ----------
--    Name_Error     - raised if the relationship key or the relation
--                     name are illegal or if a node already exists
--                     with the identification given by "New_Base",
--                     "New_Key", and "New_Relation".
--    Use_Eror       - raised if "New_Relation" is the name of a predefined
--                     relation that cannot be modified or created by the user.
--    Status_Error   - raised if the node handles "Node" and "New_Base" are
--                     not open.
--    Intent_Violation  - raised if "New_Base" was not opened with an intent
--                        establishing the right to append relationships.
--    Security_Violation - raised if the operation represents a violation
--                         of mandatory access controls.  Security_Violation
--                         is raised only if the conditions for other
--                         exceptions are not present.
--  Notes:   CAIS 5.1.2.23
--  -----
--
---------------------------------------------------------------------
        procedure Link(Node         : in out Node_Type;
                       New_Base     : in out Node_Type;
                       New_Key      : Relationship_Key;
                       New_Relation : Relation_Name := Default_Relation);

    -- Additional Interface
        procedure Link(Node     : in out Node_Type;
                       New_Name : Name_String);

--------------------------   U N L I N K     ------------------------
--
--  Purpose:
--  -------
--    This procedure deletes a secondary relationship identified by the
--    "Base", "Key", and "Relation" parameters.
--
--  Parameters:
--  ----------
--    Base     - an open node handle to the node from which the relationship
--               emanates which is to be deleted.
--    Key      - the relationship key of the relationship to be deleted.
--    Relation - the relation name of the relation to be deleted.
--
--  Exceptions:
--  ----------
--    Name_Error    - raised if the relationship identified by "Base",
--                    "Key", and "Relation" does not exist.
--    Use_Error     - raised if the specific relationship is a primary
--                    relationship.  Use_Eror is also raised if "Relation"
--                    is the name of a predefined relation that cannot be
--                    modified or created by the user.
--    Status_Error  - raised if the "base" is not an open node handle.
--    Intent_Violation - raised if "Base" was not opened with an intent
--                    establishing the right to write relationships.
--    Security_Violation - raised if the operation represents a violation
--                         of mandatory access controls.  Security_Violation
--                         is raised only if the conditions for other
--                         exceptions are not present.
--
--  Notes:   CAIS 5.1.2.24
--  -----
--
---------------------------------------------------------------------
        procedure Unlink(Base     : in out Node_Type;
                         Key      : Relationship_Key;
                         Relation : Relation_Name := Default_Relation);

    -- Additional Interface
        procedure Unlink(Name : Name_String);


----------------------     I T E R A T E     ------------------------
--
--  Purpose:
--  -------
--    This procedure establishes a node iterator "Iterator" over the
--    set of nodes that are the targets of relationships emanating
--    from a given node identified by "Node" and matching the specified
--    "Key" and "Relation" patterns.  Nodes that are of a different kind
--    than the "Kind" specified are omitted by subsequent calls to
--    "Get_Next" using the resulting iterator.  If "Primary_Only" is
--    true, then the iterator will be based only on primary relationships.
--
--  Parameters:
--  ----------
--    Iterator      - the node iterator returned.
--    Node          - an open node handle to a node whose relationships
--                    form the basis for constructing the iterator.
--    Kind          - the kind of nodes on which the iterator is based.
--    Key           - the pattern for the relationship keys on which
--                    the iterator is based.
--    Relation      - the pattern for the relation names on which
--                    the iterator is based.
--    Primary_Only  - if true, the iterator will be based on only
--                    primary relationships; if false, the iterator
--                    will be based on all relationships satisfying
--                    the pattern.
--
--  Exceptions:
--  ----------
--    Use_Error     - raised if the pattern given in "Key" or "Relation"
--                    is syntactically illegal.
--    Status_Error  - raised if "Node" is not an open node.
--    Intent_Violation - raised if "Node" was not opened with an intent
--                       establishing the right to read relationships.
--
--  Notes:   CAIS 5.1.2.26
--  -----
--
---------------------------------------------------------------------
        procedure Iterate(-- build an iterator
                          Iterator     : in out Node_Iterator;
                                          -- see CAIS 1.4 5.1.2.25 for expl.)
                          Node         : in Node_Type;
                                          -- open node handle for desired node
                          Kind         : in Node_Kind;
                                          -- kind of nodes to include
                          Key          : in Relationship_Key_Pattern := "*";
                                          -- pattern to select keys
                          Relation     : in Relation_Name_Pattern :=
                              Default_Relation;
                                          -- pattern to select relations
                          Primary_Only : in Boolean := True);
    -------------------------------------------------------------------------
    --         ALTERNATE INTERFACE via NAME_STRING for NODE                --
    -------------------------------------------------------------------------
        procedure Iterate(-- build an iterator
                          Iterator     : in out Node_Iterator;
                                          -- see CAIS 1.4 5.1.2.25 for expl.)
                          Name         : in Name_String;
                                          -- pathname of iterator's source node
                          Kind         : in Node_Kind;
                                          -- kind of nodes to include
                          Key          : in Relationship_Key_Pattern := "*";
                                          -- pattern to select keys
                          Relation     : in Relation_Name_Pattern :=
                              Default_Relation;
                                          -- pattern to select relations
                          Primary_Only : in Boolean := True);

-------------------------   M O R E       ---------------------------
--
--  Purpose:
--  -------
--    This function returns False if all nodes contained in the node
--    iterator have been retrieved with the "Get_Next" procedure;
--    otherwise it returns True.
--
--  Parameters:
--  ----------
--    Iterator  - a node iterator previously set by the procedure
--                "Iterate".
--
--  Exceptions:
--  ----------
--    Use_Error   - raised if the"Iterator" has not been previously
--                  set by the procedure "Iterate".
--
--  Notes:   CAIS 5.1.2.28
--  -----
--
---------------------------------------------------------------------
        function More(
                    -- indicate if all nodes have been retrieved via Get_Next
                      Iterator : in Node_Iterator)
                                    -- previously constructed iterator
        return Boolean;


----------------------    G E T _ N E X T      ----------------------
--
--  Purpose:
--  -------
--    This procedure returns an open node handle to the next node in the
--    parameter "Next_Node"; the intent under which the node handle is
--    opened is specified by the "Intent" parameter.  If "Next_Node"
--    is open prior to the call to "Get_Next", it is closed prior to
--    being opened to the next node.  A time limit can be specified
--    for the maximum delay permitted if the node to be opened is locked
--    against access with the specified "Intent".
--
--  Parameters:
--  ----------
--    Iterator     - node iterator previously set by "Iterate".
--    Next_Node    - node handle to be opened to the next node on the
--                   iterator.
--    Intent       - the intent of subsequent operations on the node
--                   handle "Next_Node".
--    Time_Limit   - specifies the time limit for the delay on waiting
--                   for the unlocking of the node in accordance with the
--                   desired "Intent".
--
--  Exceptions:
--  ----------
--    Name_Error    - raised if the node whose node handle is to be
--                    returned by "Next_Node" is unobtainable and if the
--                    "Intent" includes any intent other than "Existance".
--    Use_Error     - raised if the iterator has not been previously set
--                    by "Iterate" or if the iterator has been exhausted
--                    or if "Intent" is an empty array.
--    Lock_Error    - raised if the opening of this node is delayed beyond
--                    the specified "Time_Limit" due to the existence of
--                    locks in conflict with the specified "Intent".
--    Access_Violation - raised if the current process's discretionary
--                       access control rights are insufficient to obtain
--                       access to the next node with the specified intent.
--                       Access_Violation is raised only if the conditions
--                       for Name_Error are not present.
--    Security_Violation - raised if the operation represents a violation
--                         of mandatory access controls.  Security_Violation
--                         is raised only if the conditions for other
--                         exceptions are not present.
--
--  Notes:   CAIS 5.1.2.28
--  -----
--
---------------------------------------------------------------------
        procedure Get_Next(
                          -- get open node handle to next node  in iterator
                           Iterator   : in out Node_Iterator;
                                          -- see CAIS 1.4 5.1.2.25 for expl.
                           Next_Node  : in out Node_Type;
                                          -- will be the open node handle
                           Intent     : in Intention := (1 => Existence);
                                                     --intent for opening
                           Time_Limit : in Duration := No_Delay);
                                                     --time limit for opening

    private

    -- The following type declaration supports the Node_Iterator type
        type Pseudo_List_Type is access List_Utilities.List_Type;
        type Node_Iterator is
            record
                List             : Pseudo_List_Type;
                                                --List of relations where each
                                                --relation contains a list of
                                                --keys
                Rel_Position     : List_Utilities.Count := 0;
                                                        --current Relation
                Key_Position     : List_Utilities.Count := 0;
                                                        --current Key
                Base_Name_Length : Integer range 1 .. Pragmatics.Max_Name_String
                    ;
                Base_Name        : String(1 .. Pragmatics.Max_Name_String);
                                                --pathname of node
                                                --from which Iterator
                                                --is created. Actual
                                                --length is Base_Name_Length
            end record;

---------------------------------------------------------------------
    end Node_Management;
                       --  END OF PACKAGE SPEC
---------------------------------------------------------------------
----------------------------------------------------------------------
--                         A T T R I B U T E S
--
--  Purpose:
--  --------
--    This  package  supports  the  definition  and  manipulation   of
--    attributes for nodes and relationships in the CAIS.  The name of
--    an attribute follows the syntax of an Ada  identifier  (Ada  LRM
--    2.3).  The value of an attribute is a list of the format defined
--    by the  package  list_utilities  (MIL-STD CAIS section  5.4).
--    Upper  vs.  lower  case  distinctions are significant within the
--    value of attributes, but not within the attribute name.
--
--  Usage:
--  -----
--    The operations defined  for  the  manipipulation  of  attributes
--    identify  the  node  to  which  an  attribute  belongs either by
--    pathname or open node  handle.   They  identify  a  relationship
--    implicitly  by the last path element of a pathname or explicitly
--    by base node, key and relation name identification.
--
--  Example:
--  -------
--        To_List( "(""17NOV85"")", String_Value);
--        To_List( "(""14APR86"")", New_Value);
--          Create_Node_Attribute(Node, "DATE", String_Value);
--        Set_Node_Attribute   (Node, "DATE", New_Value);
--        Get_Node_Attribute   (Node, "DATE", String_Value);
--        Delete_Node_Attribute(Node, "DATE");
--
--        Node_Attribute_Iterate(Node, Iterator, "D*");
--        while More(Iterator) loop
--            Get_Next(Iterator, Attribute, Value);
--        end loop;
--
--  Notes:
--  -----
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------
    package Attributes is

        use Node_Definitions;
        use List_Utilities;

    -- The following type declarations are from CAIS section 5.1.3.9
        subtype Attribute_Name is String;
        type Attribute_Iterator is private;
        subtype Attribute_Pattern is String;
    -- This type is needed to define Attribute_Iterator
        type Pseudo_List_Type is access List_Type;
----------------------   Create_Node_Attribute ----------------------
--
--  Purpose: This procedure creates an attribute named by ATTRIBUTE of
--  -------  of the node identified by the open node handle NODE and sets
--           its initial value to VALUE.
--
--  Parameters:
--  ----------
--    Node       is the open node handle being modified
--    Attribute  is the name of the attribute being added to this node
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   USE_ERROR          is raised if the node already has an attribute of the
--                given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute.
--
--   STATUS-ERROR       is raised if the node handle is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            append attributes.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.1
--  -----
--   Security_Violation is not implemented
---------------------------------------------------------------------
    -- CAIS 5.1.3.1
        procedure Create_Node_Attribute(
                                      -- create attribute, set initial value
                                        Node      : in out Node_Type;
                                      -- open node handle for desired node
                                        --************************************
                                        --PROPOSED DEVIATION FROM MIL STD CAIS
                                        --************************************
                                        Attribute : Attribute_Name;
                                      -- name of the attribute
                                        Value     : List_Type);
                                      -- initial value of the attribute
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for Relationship        --
-----------------------------------------------------------------------------
        procedure Create_Node_Attribute(
                                      -- create attribute, set initial value
                                        Name      : Name_String;
                                      -- pathname of desired node
                                        Attribute : Attribute_Name;
                                      -- name of the attribute
                                        Value     : List_Type);
                                      -- initial value of the attribute


----------------------  Create_Path_Attribute  ----------------------
--  Purpose: This procedure creates an attribnute named by ATTRIBUTE of
--  -------  of a relationship and sets its initial value to VALUE.  The
--         relationship is defined by the base node defined by the open
--         node handle BASE, the relation name RELATION, and the
--         relationship key KEY.
--
--  Parameters:
--  ----------
--    Base       is the open node handle of the base node
--    Key       is the relationship key of the affected relationship
--    Relation   is the relation name of the affected relationship
--    Attribute  is the name of the attribute added to this relationship
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   NAME_ERROR        is raised if the relationship identified by BASE, KEY,
--            and RELATION does not exist
--
--   USE_ERROR          is raised if the relationship already has an attribute
--            of the given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute
--            that cant be modified by the user. Use_Error is also
--            raised if RELATION is the name of a predefined relation
--            that can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle BASE is not open
--   INTENT_VIOLATION   is raised if BASE was not opened with the right to
--            write relationships.
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.2
--  -----
--   Security_Violation is not implemented
---------------------------------------------------------------------
        procedure Create_Path_Attribute(-- Create an attribute
                                        Base      : in out Node_Type;
                                     -- open node handle from which
                                     -- the relationship emanates
                                        Key       : Relationship_Key;
                                     -- key of affected relationship
                                        Relation  : Relation_Name :=
                                            Default_Relation;
                                     -- name of affected relationship
                                        Attribute : Attribute_Name;
                                     -- name of created attribute
                                        Value     : List_Type);
                                     -- initial value of the attribute
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
        procedure Create_Path_Attribute(-- Create an attribute
                                        Name      : Name_String;
                                     -- pathname of desired node
                                        Attribute : Attribute_Name;
                                     -- name of created attribute
                                        Value     : List_Type);
                                     -- initial value of the attribute
----------------------  Delete_Node_Attribute  ----------------------
--
--  Purpose: This procedure deletes an attribute named by ATTRIBUTE of
--  -------  of the node identified by the open node handle NODE.
--
--  Parameters:
--  ----------
--    Node       is the open node handle being modified
--    Attribute  is the name of the attribute being added to this node
--
--  Exceptions:
--  ----------
--   USE_ERROR          is raised if the node does not have an attribute of the
--                given name (or if the name given is syntactically
--                      illegal??) or is the name of a predefined node attribute
--            which can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            write attributes.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.3
--  -----
--   Security_Violation is not implemented
---------------------------------------------------------------------
    -- CAIS 5.1.3.3
        procedure Delete_Node_Attribute(
                                       -- Delete an attribute
                                        Node      : in out Node_Type;
                                      -- open node handle for desired node
                                        --************************************
                                        --PROPOSED DEVIATION FROM MIL STD CAIS
                                        --************************************
                                        Attribute : Attribute_Name);
                                     -- name of the attribute to be deleted
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
        procedure Delete_Node_Attribute(
                                       -- Delete an attribute
                                        Name      : Name_String;
                                     -- pathname of desired node
                                        Attribute : Attribute_Name);
                                     -- name of the attribute to be deleted


----------------------  Delete_Path_Attribute  ----------------------
--  Purpose: This procedure creates an attribnute named by ATTRIBUTE of
--  -------  of a relationship and sets its initial value to VALUE.  The
--         relationship is defined by the base node defined by the open
--         node handle BASE, the relation name RELATION, and the
--         relationship key KEY.
--
--  Parameters:
--  ----------
--    Base       is the open node handle of the base node
--    Key       is the relationship key of the affected relationship
--    Relation   is the relation name of the affected relationship
--    Attribute  is the name of the attribute added to this relationship
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   NAME_ERROR        is raised if the relationship identified by BASE, KEY,
--            and RELATION does not exist
--
--   USE_ERROR          is raised if the relationship already has an attribute
--            of the given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute
--            that cant be modified by the user. Use_Error is also
--            raised if RELATION is the name of a predefined relation
--            that can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle BASE is not open
--   INTENT_VIOLATION   is raised if BASE was not opened with the right to
--            write relationships.
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.4
--  -----
--   Security_Violation is not implemented
---------------------------------------------------------------------
        procedure Delete_Path_Attribute(-- delete an attribute
                                        Base      : in out Node_Type;
                                        -- open node handle from which
                                        -- the relationship emanates
                                        Key       : Relationship_Key;
                                        -- key of affected relationship
                                        Relation  : Relation_Name :=
                                            Default_Relation;
                                        -- name of affected relationship
                                        Attribute : Attribute_Name);
                                        -- name of created attribute
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
        procedure Delete_Path_Attribute(-- delete an attribute
                                        Name      : Name_String;
                                        -- pathname of desired node
                                        Attribute : Attribute_Name);
                                        -- name of created attribute
----------------------SET_NODE_ATTRIBUTE-----------------------------
--
--  Purpose: This procedure deletes an attribute named by ATTRIBUTE of
--  -------  of the node identified by the open node handle NODE.
--
--  Parameters:
--  ----------
--    Node       is the open node handle being modified
--    Attribute  is the name of the attribute being added to this node
--
--  Exceptions:
--  ----------
--   USE_ERROR          is raised if the node does not have an attribute of the
--                given name (or if the name given is syntactically
--                      illegal??) or is the name of a predefined node attribute
--            which can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            write attributes.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.5
--  -----
--   Security_Violation is not implemented
---------------------------------------------------------------------
    -- CAIS 5.1.3.5
        procedure Set_Node_Attribute(  -- Set the value of existing attribute
                                     Node      : in out Node_Type;
                                      -- open node handle for desired node
                                        --************************************
                                        --PROPOSED DEVIATION FROM MIL STD CAIS
                                        --************************************
                                     Attribute : Attribute_Name;
                                         -- name of attribute to be set
                                     Value     : List_Type);
                                         -- new value of attribute
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
        procedure Set_Node_Attribute(  -- Set the value of existing attribute
                                     Name      : Name_String;
                                         -- pathname of desired node
                                     Attribute : Attribute_Name;
                                         -- name of attribute to be set
                                     Value     : List_Type);
                                         -- new value of attribute
----------------------    Set_Path_Attribute   ----------------------
--  Purpose: This procedure creates an attribnute named by ATTRIBUTE of
--  -------  of a relationship and sets its initial value to VALUE.  The
--         relationship is defined by the base node defined by the open
--         node handle BASE, the relation name RELATION, and the
--         relationship key KEY.
--
--  Parameters:
--  ----------
--    Base       is the open node handle of the base node
--    Key       is the relationship key of the affected relationship
--    Relation   is the relation name of the affected relationship
--    Attribute  is the name of the attribute added to this relationship
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   NAME_ERROR        is raised if the relationship identified by BASE, KEY,
--            and RELATION does not exist
--
--   USE_ERROR          is raised if the relationship already has an attribute
--            of the given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute
--            that cant be modified by the user. Use_Error is also
--            raised if RELATION is the name of a predefined relation
--            that can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle BASE is not open
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            write relationships.
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.6
--  -----
--   Security_Violation is not implemented
---------------------------------------------------------------------
        procedure Set_Path_Attribute(-- Set the value of an existing attribute
                                     Base      : in out Node_Type;
                                        -- open node handle from which
                                        -- the relationship emanates
                                     Key       : Relationship_Key;
                                        -- key of affected relationship
                                     Relation  : Relation_Name :=
                                         Default_Relation;
                                        -- name of affected relationship
                                     Attribute : Attribute_Name;
                                        -- name of created attribute
                                     Value     : List_Type);
                                        -- new value of attribute
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
        procedure Set_Path_Attribute(-- Set the value of an existing attribute
                                     Name      : Name_String;
                                        -- pathname of desired node
                                     Attribute : Attribute_Name;
                                        -- name of created attribute
                                     Value     : List_Type);
                                        -- new value of attribute
----------------------    Get_Node_Attribute   ----------------------
--
--  Purpose: This procedure deletes an attribute named by ATTRIBUTE of
--  -------  of the node identified by the open node handle NODE.
--
--  Parameters:
--  ----------
--    Node       is the open node handle being modified
--    Attribute  is the name of the attribute being added to this node
--
--  Exceptions:
--  ----------
--   USE_ERROR          is raised if the node does not have an attribute of the
--                given name (or if the name given is syntactically
--                      illegal??) or is the name of a predefined node attribute
--            which can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle is not open
--
--   INTENT_VIOLATION   is raised if NODE was not opened with the right to
--            read attributes.
--
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.7
--  -----
--   Security_Violation is not implemented
---------------------------------------------------------------------
    -- CAIS 5.1.3.7
        procedure Get_Node_Attribute( -- get the value of a node attribute
                                     Node      : Node_Type;
                                         -- open node handle for desired node
                                     Attribute : Attribute_Name;
                                         -- name of created attribute
                                     Value     : in out List_Type);
                                         -- result parm containing the value
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
        procedure Get_Node_Attribute( -- get the value of a node attribute
                                     Name      : Name_String;
                                         -- pathname of desired node
                                     Attribute : Attribute_Name;
                                         -- name of created attribute
                                     Value     : in out List_Type);
                                         -- result parm containing the value
----------------------   Get_Path_Attribute    ----------------------
--  Purpose: This procedure creates an attribnute named by ATTRIBUTE of
--  -------  of a relationship and sets its initial value to VALUE.  The
--         relationship is defined by the base node defined by the open
--         node handle BASE, the relation name RELATION, and the
--         relationship key KEY.
--
--  Parameters:
--  ----------
--    Base       is the open node handle of the base node
--    Key       is the relationship key of the affected relationship
--    Relation   is the relation name of the affected relationship
--    Attribute  is the name of the attribute added to this relationship
--    Value      is the initial value of the attribute
--
--  Exceptions:
--  ----------
--   NAME_ERROR        is raised if the relationship identified by BASE, KEY,
--            and RELATION does not exist
--
--   USE_ERROR          is raised if the relationship already has an attribute
--            of the given name or if the name given is syntactically
--                      illegal or is the name of a predefined node attribute
--            that cant be modified by the user. Use_Error is also
--            raised if RELATION is the name of a predefined relation
--            that can't be modified by the user.
--
--   STATUS-ERROR       is raised if the node handle BASE is not open
--   INTENT_VIOLATION   is raised if BASE was not opened with the right to
--            read relationships.
--   SECURITY_VIOLATION is raised if the operation represents a violation of
--            mandatory access controls.  Raised only if no other
--            exceptions apply.
--
--  Notes: MIL-STD CAIS 5.1.3.8
--  -----
--   Security_Violation is not implemented
---------------------------------------------------------------------
        procedure Get_Path_Attribute(-- get the value of a path attribute
                                     Base      : Node_Type;
                                        -- open node handle from which
                                        -- the relationship emanates
                                     Key       : Relationship_Key;
                                        -- key of affected relationship
                                     Relation  : Relation_Name :=
                                         Default_Relation;
                                         -- name of affected relationship
                                     Attribute : Attribute_Name;
                                         -- name of created attribute
                                     Value     : in out List_Type);
                                         -- result parm containing the value
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
        procedure Get_Path_Attribute(-- get the value of a path attribute
                                     Name      : Name_String;
                                         -- pathname of desired node
                                     Attribute : Attribute_Name;
                                         -- name of created attribute
                                     Value     : in out List_Type);
                                         -- result parm containing the value
-- CAIS 5.1.3.9 is a collection of type definitions; they are
-- at start of this package specification.


--------------------------NODE_ATTRIBUTE_ITERATE---------------------
--
--  Purpose:  Creates a set of attributes from the named node which
--  -------   match the provided pattern containing wild card characters
--            '*' to match any string and '?' to match any character.
--
--  Parameters:
--  ----------
--   Iterator is the set of matching attributes
--   Node     is the node whose attributes are searched for matches
--   Pattern  is the string (with * and ?) which determines matches
--
--  Exceptions:
--  ----------
--   Use_Error        is raised if the Pattern is syntactically illegal
--
--   Status_Error     is raised if the node is not an open node handle
--
--   Intent_Violation is rasied if Node is not open with the right to
--              read attributes.
--
--  Notes: MIL-STD CAIS 5.1.3.10
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.10
        procedure Node_Attribute_Iterate(-- get an attribute iterator
                                         Iterator : in out Attribute_Iterator;
                                               -- see CAIS 1.4 5.1.3 for expl.)
                                         Node     : Node_Type;
                                     -- open node handle for desired node
                                         Pattern  : Attribute_Pattern := "*");
                                                -- pattern for attr. names
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
        procedure Node_Attribute_Iterate(-- get an attribute iterator
                                         Iterator : in out Attribute_Iterator;
                                               -- see CAIS 1.4 5.1.3 for expl.)
                                         Name     : Name_String;
                                               -- pathname of desired node
                                         Pattern  : Attribute_Pattern := "*");
                                               -- pattern for attr. names
----------------------  Path_Attribute_Iterate  ----------------------
--
--  Purpose:  Creates a set of attributes from the named path which
--  -------   match the provided pattern containing wild card characters
--            '*' to match any string and '?' to match any character.
--
--  Parameters:
--  ----------
--   Iterator is the set of matching attributes
--   Base     is the open node handle from which the relationship emanates
--   Key      is the key of the affected relationship
--   Relation is the name of the affected relationship
--   Pattern  is the string (with * and ?) which determines matches
--
--  Exceptions:
--  ----------
--   Use_Error        is raised if the Pattern is syntactically illegal
--
--   Status_Error     is raised if the node is not an open node handle
--
--   Intent_Violation is rasied if Node is not open with the right to
--              read relationships.
--
--  Notes: MIL-STD CAIS 5.1.3.11
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.11
        procedure Path_Attribute_Iterate(
                                       -- get iterator over relationship attr.
                                         Iterator : in out Attribute_Iterator;
                                              -- see CAIS 1.4 5.1.3 for expl.)
                                         Base     : Node_Type;
                                        -- open node handle from which
                                        -- the relationship emanates
                                         Key      : Relationship_Key;
                                        -- key of the relationship
                                         Relation : Relation_Name :=
                                             Default_Relation;
                                        -- name of the relationship
                                         Pattern  : Attribute_Pattern := "*");
                                                -- pattern for attr. names
-----------------------------------------------------------------------------
--             ALTERNATE INTERFACE via NAME_STRING for NODE                --
-----------------------------------------------------------------------------
        procedure Path_Attribute_Iterate(
                                       -- get iterator over relationship attr.
                                         Iterator : in out Attribute_Iterator;
                                               -- see CAIS 1.4 5.1.3 for expl.)
                                         Name     : Name_String;
                                               -- pathname of desired node
                                         Pattern  : Attribute_Pattern := "*");
                                               -- pattern for attr. names

----------------------          More           ----------------------
--
--  Purpose: The function More returns false if all attributes contained
--  -------  in the attribute iterator have been retrieved with the procedure
--         Get_Next; otherwise, it returns true.
--
--  Parameters:
--  ----------
--    Iterator is a previously constructed attribute iterator.
--
--  Exceptions:
--  ----------
--    Use_Error is raised if the iterator has not been previously set by the
--        procedure Node_Attribute_Iterate or Path_Attribute_Iterate.
--
--  Notes: MIL-STD CAIS 5.1.3.12
--  -----
--
---------------------------------------------------------------------
    -- CAIS 5.1.3.12
        function More(
                    -- indicate if all attr. have been retrieved via Get_Next
                      Iterator : in Attribute_Iterator)
                                         -- previously constructed iterator
        return Boolean;

----------------------          Get_Next       ----------------------
--
--  Purpose: Returns, in the parameters Attribute and Value, both the name
--  -------  and the value of the next attribute in the iterator.
--
--  Parameters:
--  ----------
--    Iterator  is a previously constructed iterator.
--    Attribute contains the name of the retrieved attribute.
--    Value     contains the value of the attribute named by Attribute.
--
--  Exceptions:
--  ----------
--    Use_Error is raised if the Iterator has not been previously set by the
--        procedure Node_Attribute_Iterate or Path_Attribute_Iterate or if the
--        iterator is exhausted, i.e., More(Iterator) = false.
--
--  Notes: MIL-STD CAIS 5.1.3.13
--  -----
--
------------------------------------------------------------------------------
    -- CAIS 5.1.3.13
        procedure Get_Next(
                          -- get name and value of next attribute  in iterator
                           Iterator  : in out Attribute_Iterator;
                                               -- see CAIS 1.4 5.1.3 for expl.)
                           Attribute : in out Attribute_Name;
                                                  -- name of next attribute
                           Value     : in out List_Type);
                                               -- value of next attribute
    private

        type Attribute_Iterator is
            record
                List     : Pseudo_List_Type;
                                        --the set of attributes being iterated
                Position : Count := 0;  --current attribute to be supplied
            end record;

---------------------------------------------------------------------------
    end Attributes;
                --END OF PACKAGE SPEC
---------------------------------------------------------------------------

    package Access_Control is
        use Node_Definitions;

        subtype Grant_Value is Cais.List_Utilities.List_Type;
        procedure Set_Access_Control(Node      : Node_Type;
                                     Role_Node : Node_Type;
                                     Grant     : Grant_Value);
        procedure Set_Access_Control(Name      : Name_String;
                                     Role_Name : Name_String;
                                     Grant     : Grant_Value);
        function Is_Granted(Object_Node  : Node_Type;
                            Access_Right : Name_String) return Boolean;
        function Is_Granted(Object_Name  : Name_String;
                            Access_Right : Name_String) return Boolean;
        procedure Adopt(Role_Node : Node_Type;
                        Role_Key  : Relationship_Key := Latest_Key);
        procedure Unadopt(Role_Key : Relationship_Key);
    end Access_Control;

----------------------------------------------------------------------
--                S T R U C T U R A L _ N O D E S
--
--  Purpose:
--  -------
--      Structural nodes are special nodes in the sense that they
--      do not have contents as the other nodes of the CAIS model do.
--      Their purpose is solely to be carriers of common information
--      about other nodes related to the structural node.  This package
--      defines the primitive operations for creating structural nodes.
--
--  Usage:
--  -----
--      Structural nodes are typically used to create conventional
--      directories, configuration objects, etc.
--
--  Example:
--  -------
--      TBS
--
--  Notes:
--  -----
--      This package is defined in section 5.1.5 of the MIL-STD CAIS
--      specification, dated 31 January 1985.
--
--  Revision History:
--  ----------------
--      None.
--
-------------------------------------------------------------------

    package Structural_Nodes is

        use List_Utilities;
        use Node_Definitions;

----------------------  C R E A T E _ N O D E  ----------------------
--
--  Purpose:
--  -------
--    This procedure creates a structural node and installs the
--    primary relationship to it.  The relation name and relationship
--    key of the primary relationship to the node and the base node
--    from which it emanates are given by the parameters Relation,
--    Key, and Base.  An open node handle to the newly created node
--    with WRITE intent is returned in Node.
--
--  Parameters:
--  ----------
--    Node        closed node handle to be opened to the new node
--    Base        open node handle to the node from which the primary
--            relationship to the new node is to emanate
--    Key         relationship key of the primary relation to be created
--    Relation    relation name of the primary relation to be created
--    Attributes  a named list whose elements are used to establish
--                initial values for attributes of the new node
--    Access_Control  initial access control information associated with
--                the new node
--    Level       classification level for the new node
--
--  Exceptions:
--  ----------
--    NAME_ERROR        - if a node exists for the node identification
--                        given, if the node identification is illegal,
--                        or if any node identifying a group specified
--                        in the given Access_Control parameter is
--                        unobtainable or inaccessible.
--    USE_ERROR         - if Access_Control or Level parameters do not adhere
--                        to the required syntax or if the Attributes parameter
--                        contains references to predefined attributes which
--                        cannot be modified or created by the user.
--                        USE_ERROR is also raised if Relation is the name
--                        of a predefined relation that cannot be modified
--                        or created by the user.
--    STATUS_ERROR      - if Base is not open or if Node is open
--    INTENT_VIOLATION  - if Base was not opened with an intent establishing
--                        the right to append relationships
--    SECURITY_VIOLATION  if the operation violates mandatory access
--                        controls; raised only if conditions for other
--                        exceptions are not met.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.1.5.1 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interfaces for Create_Node that are presented
--    in that section are provided.
--    NOTE: The second additional interface described in the CAIS
--    spec appears to be erroneous; the body defined for it is NOT
--    a mapping to another Create_Node, but is a recursive call to
--    itself.  The signature for this interface is distinct because
--    lacks an in/out parameter of Node_Type.  The call to Create_Node
--    in this body uses a local variable as a "placeholder" for the
--    unused node handle.  However, it lacks a base node for the
--    call.  The body in this package reflects our belief that the
--    CAIS spec is not what was intended for this procedure.
--
---------------------------------------------------------------------

        procedure Create_Node(Node           : in out Node_Type;
                              Base           : in out Node_Type;
                                            -- different from MIL-STD
                              Key            : Relationship_Key := Latest_Key;
                              Relation       : Relation_Name := Default_Relation
                                  ;
                              Attributes     : List_Type := Empty_List;
                              Access_Control : List_Type := Empty_List;
                              Level          : List_Type := Empty_List);


    -- "Alternate Interface 1"
        procedure Create_Node(Node           : in out Node_Type;
                              Name           : Node_Definitions.Name_String;
                              Attributes     : List_Type := Empty_List;
                              Access_Control : List_Type := Empty_List;
                              Level          : List_Type := Empty_List);

    -- "Alternate Interface 2"
        procedure Create_Node(Base           : in out Node_Type;
        -- defined but not used in MIL-STD-CAIS

                              Key            : Relationship_Key := Latest_Key;
                              Relation       : Relation_Name := Default_Relation
                                  ;
                              Attributes     : List_Type := Empty_List;
                              Access_Control : List_Type := Empty_List;
                              Level          : List_Type := Empty_List);


    -- "Alternate Interface 3"
        procedure Create_Node(Name           : Node_Definitions.Name_String;
                              Attributes     : List_Type := Empty_List;
                              Access_Control : List_Type := Empty_List;
                              Level          : List_Type := Empty_List);


    end Structural_Nodes;

----------------------------------------------------------------------
--               P R O C E S S _ D E F I N I T I O N S
--
--  Purpose:
--  -------
--    This package defines the types and exceptions associated with
--    CAIS process nodes.
--
--  Usage:
--  -----
--    Simply referenced by code requiring these types and exceptions.
--
--  Example:
--  -------
--    None.
--
--  Notes:
--  -----
--    CAIS MIL-STD 5.2.1 dated 31 January 1985
--
--  Revision History:
--  ----------------
--    None.
--
-------------------------------------------------------------------

    package Process_Definitions is

        use Node_Definitions;
        use List_Utilities;

        type Process_Status is (Ready, Suspended, Aborted, Terminated);

        subtype Results_List is List_Utilities.List_Type;
        subtype Results_String is String;
        subtype Parameter_List is List_Utilities.List_Type;

        Root_Process   : constant Name_String := "'CURRENT_JOB";
        Current_Input  : constant Name_String := "'CURRENT_INPUT";
        Current_Output : constant Name_String := "'CURRENT_OUTPUT";
        Current_Error  : constant Name_String := "'CURRENT_ERROR";

    end Process_Definitions;

----------------------------------------------------------------------
--                    P R O C E S S _ C O N T R O L
--
--  Purpose:
--  -------
--    This package specifies interfaces for the creation and termination
--    of process and the examination and modification of process node
--    attributes.
--
--  Usage:
--  -----
--    See Section 5.2.2 of MIL-STD-CAIS
--
--  Example:
--  -------
--    See Section 5.2.2 of MIL-STD-CAIS
--
--  Notes:     MIL-STD-CAIS 5.2.2
--  -----
--    The subprograms in this package are currently stubbed, with the
--    exception of the procedure Invoke_Process.
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------


    package Process_Control is

        use Node_Definitions;
        use List_Utilities;
        use Process_Definitions;


        procedure Spawn_Process(Node             : in out Node_Type;
                                File_Node        : Node_Type;
                                Input_Parameters : Parameter_List := Empty_List
                                    ;
                                Key              : Relationship_Key :=
                                    Latest_Key;
                                Relation         : Relation_Name :=
                                    Default_Relation;
                                Access_Control   : List_Type := Empty_List;
                                Level            : List_Type := Empty_List;
                                Attributes       : List_Type := Empty_List;
                                Input_File       : Name_String := Current_Input
                                    ;
                                Output_File      : Name_String := Current_Output
                                    ;
                                Error_File       : Name_String := Current_Error
                                    ;
                                Environment_Node : Name_String := Current_Node)
            ;

        procedure Await_Process_Completion(Node       : Node_Type;
                                           Time_Limit : Duration := Duration'
                                               Last);
        procedure Await_Process_Completion(Node             : Node_Type;
                                           Results_Returned : in out
                                               Results_List;
                                           Status           : in out
                                               Process_Status;
                                           Time_Limit       : Duration :=
                                               Duration'Last);

----------------- I N V O K E _ P R O C E S S  ----------------------
--
--  Purpose:
--  -------
--    This procedure creates a new process node whose contents represent
--    the execution of the program contained in the specified file node.
--    Control returns to the calling task after the new process is
--    terminated.
--
--  Parameters:
--  ----------
--    Node              - node handle returned open on the new process node
--    File_Node         - open node handle on the file node containing the
--                        executable image whose execution will be
--                        represented by the new process
--    Results_Returned  - list of results which are represented by strings
--                        from the new process.
--    Status            - the process status of the process.
--    Input_Parameters  - a list containing process parameter information.
--    Key               - the relationship key of the primary relationship
--                        from the current process node to the new process
--                        node.
--    Relation          - the relation name of the primary relationship
--                        from the current process node to the new node.
--    Access_Control    - defines the initial access control information
--                        associated with the created node.
--    Level             - defines the classification label for the created
--                        node.
--    Attributes        - a list which can be used to set attributes of the
--                        new node.
--    Input_File        - pathname for standard input for the new process
--    Output_File       - pathname for standard output for the new process
--    Error_File        - pathname for error output for the new process
--    Environment_Node  - the node the new process will have as its current
--                        node
--    Time_Limit        - the limit on the time that the calling task will
--                        be suspended awaiting the new process.  When
--                        the limit is exceeded, the calling task resumes
--                        execution.

--
--  Exceptions:
--  ----------
--    Name_Error        - raised if a node alreadyt exists for the
--                        relationship specified by Key and Relation.
--                        Name_Error is also raised if any of the nodes
--                        identified by Input_File, Output_File,
--                        Error_File, or Environment_Node do not exist.
--                        It is also raised if Key or Relation is
--                        syntactically illegal or if any node identifying
--                        a group specified in the given  Access_Control
--                        parameter is unobtainable or inaccessible.
--    Use_Error         - is raised if it can be determined that the node
--                        indicated by File_Node does not contain an executable
--                        image.  Use_Error is also raised if any of the
--                        parameters Input_Paramters, Level, Access_Control,
--                        or Attributes is syntactically illegal.  Use_Error
--                        is also raised if Relation is the name of a
--                        predefined relation or if the Attributes parameter
--                        contains references to a predefined attribute which
--                        cannot be modified or created by the user.
--    Status_Error      - is raised if Node is an open node handle prior to
--                        the call or if File_Node is not an open node handle.
--    Lock_Error        - is raised if access with intent Append_Relationships
--                        cannot be obtained to the current process node due
--                        to an existing lock on the node.
--    Intent_Violation  - is raised if the node designated by File_Node was
--                        not opened with an intent establishing the right
--                        to execute contents.
--
--  Notes:   MIL-STD-CAIS 5.2.2.3
--  -----
--
---------------------------------------------------------------------

        procedure Invoke_Process(Node             : in out Node_Type;
                                 File_Node        : Node_Type;
                                 Results_Returned : in out Results_List;
                                 Status           : in out Process_Status;
                                 Input_Parameters : Parameter_List;
                                 Key              : Relationship_Key :=
                                     Latest_Key;
                                 Relation         : Relation_Name :=
                                     Default_Relation;
                                 Access_Control   : List_Type := Empty_List;
                                 Level            : List_Type := Empty_List;
                                 Attributes       : List_Type := Empty_List;
                                 Input_File       : Name_String := Current_Input
                                     ;
                                 Output_File      : Name_String :=
                                     Current_Output;
                                 Error_File       : Name_String := Current_Error
                                     ;
                                 Environment_Node : Name_String := Current_Node
                                     ;
                                 Time_Limit       : Duration := Duration'Last);
        procedure Create_Job(File_Node        : Node_Type;
                             Input_Parameters : Parameter_List := Empty_List;
                             Key              : Relationship_Key := Latest_Key;
                             Access_Control   : List_Type := Empty_List;
                             Level            : List_Type := Empty_List;
                             Attributes       : List_Type := Empty_List;
                             Input_File       : Name_String := Current_Input;
                             Output_File      : Name_String := Current_Output;
                             Error_File       : Name_String := Current_Error;
                             Environment_Node : Name_String := Current_User);
        procedure Append_Results(Results : Results_String);
        procedure Write_Results(Results : Results_String);
        procedure Get_Results(Node    : Node_Type;
                              Results : in out Results_List);
        procedure Get_Results(Node    : Node_Type;
                              Results : in out Results_List;
                              Status  : in out Process_Status);
        procedure Get_Results(Name    : Name_String;
                              Results : in out Results_List;
                              Status  : in out Process_Status);
        procedure Get_Results(Name    : Name_String;
                              Results : in out Results_List);
        procedure Get_Parameters(Parameters : in out Parameter_List);
        procedure Abort_Process(Node    : Node_Type;
                                Results : Results_String);
        procedure Abort_Process(Name    : Name_String;
                                Results : Results_String);
        procedure Abort_Process(Node : Node_Type);
        procedure Abort_Process(Name : Name_String);
        procedure Suspend_Process(Node : Node_Type);
        procedure Suspend_Process(Name : Name_String);
        procedure Resume_Process(Node : Node_Type);
        procedure Resume_Process(Name : Name_String);
        function Status_Of_Process(Node : Node_Type) return Process_Status;
        function Status_Of_Process(Name : Name_String) return Process_Status;
        function Handles_Open(Node : Node_Type) return Natural;
        function Handles_Open(Name : Name_String) return Natural;
        function Io_Units(Node : Node_Type) return Natural;
        function Io_Units(Name : Name_String) return Natural;
        function Start_Time(Node : Node_Type) return Time;
        function Start_Time(Name : Name_String) return Time;
        function Finish_Time(Node : Node_Type) return Time;
        function Finish_Time(Name : Name_String) return Time;
        function Machine_Time(Node : Node_Type) return Duration;
        function Machine_Time(Name : Name_String) return Duration;

    end Process_Control;

----------------------------------------------------------------------
--                I O _ D E F I N I T I O N S
--
--  Purpose:
--  -------
--    This package defines the types and exceptions associated
--    with file nodes.
--
--  Usage:
--  -----
--    This package contains declarations of base types and exceptions
--    for I/O.  The operations in the interface are internal
--    suprograms for use in implementation of the I/O packages.
--
--  Notes:
--  -----
--      The     use     of     a     limited     private     type
--      (IO_Definitions.File_Type)  implies  the addition of
--      subprograms to manipulate  that  type  (e.g.  to  set  or
--      extract  the  contents of an object of that type).  These
--      are in this specification, although they are additions to
--      the  CAIS  specification  for  this  package.
--
--      This is a version of the package IO_Definitions,
--      specified in MIL-STD-CAIS section 5.3.1
--      Those portions of this specification that are NOT in
--      MIL-STD-CAIS specification (i.e. added for this implementation)
--      are so indicated.
--
--  Revision History:
--  ----------------
--    None.
--
-------------------------------------------------------------------

    package Io_Definitions is

        use Node_Definitions;
                          -- Not in Cais spec
        use List_Utilities;
                        -- Not in Cais spec
        use Pragmatics;
                     -- Not in Cais spec

        type Character_Array is array(Character) of Boolean;

        type File_Mode is (In_File, Inout_File, Out_File, Append_File);

        type File_Type is limited private;


        type Function_Key_Descriptor(Length : Positive) is private;
        type Tab_Enumeration is (Horizontal, Vertical);
        type Position_Type is
            record
                Row    : Natural;
                Column : Natural;
            end record;

        Status_Error : exception renames Io_Exceptions.Status_Error;
        Mode_Error   : exception renames Io_Exceptions.Mode_Error;
        Name_Error   : exception renames Io_Exceptions.Name_Error;
        Use_Error    : exception renames Io_Exceptions.Use_Error;
        Device_Error : exception renames Io_Exceptions.Device_Error;
        End_Error    : exception renames Io_Exceptions.End_Error;
        Data_Error   : exception renames Io_Exceptions.Data_Error;
        Layout_Error : exception renames Io_Exceptions.Layout_Error;

    -- The following is NOT part of the CAIS specification.

        type Text_File_Ptr is access Text_Io.File_Type;


----------------------- Initialize ----------------------------
--
--  Purpose:
--  -------
--    Internal function to allocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are allocated from heap.
--
---------------------------------------------------------------------

        procedure Initialize(Ft : in out File_Type);

----------------------- Deallocate ----------------------------
--
--  Purpose:
--  -------
--    Internal function to deallocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are released to heap via unchecked deallocation.
--
---------------------------------------------------------------------

        procedure Deallocate(Ft : in out File_Type);

----------------------- Un_Initialized ----------------------------
--
--  Purpose:
--  -------
--    Internal function to test whether file has been
--    initialized.  Returns True if not initialized,
--    otherwise returns False.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Handle is checked for null reference.
--
---------------------------------------------------------------------

        function Un_Initialized(Ft : File_Type) return Boolean;

----------------------- Assign ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to copy one file handle record to
--    another.
--
--  Parameters:
--  ----------
--    From    (access to) source file handle record.
--    To    (access to) target file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    If the target file handle is uninitialized, Assign initializes
--    it before copying the components of the record.
--
---------------------------------------------------------------------

        procedure Assign(From : File_Type;
                         To   : in out File_Type);
-----------------------  Get_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal function to fetch (access to) the Ada file descriptor
--    for the contents file from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Text_Io.File_Type.
--    The access value returned is of type Text_File_Ptr.
--
---------------------------------------------------------------------

        function Get_File_Type(Ft : File_Type) return Text_File_Ptr;

-----------------------  Set_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store (access to) an Ada file descriptor
--    for the contents file into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--    TFD    access to the Text_Io file descriptor.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Text_Io.File_Type.
--    The access parameter is of type Text_File_Ptr.
--
---------------------------------------------------------------------

        procedure Set_File_Type(Ft  : in out File_Type;
                                Tfd : Text_File_Ptr);

-----------------------  Get_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the shadow file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

        procedure Get_Shadow_File_Name(Ft       : File_Type;
                                       Name     : in out String;
                                       Lastchar : in out Natural);

-----------------------  Set_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the shadow file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

        procedure Set_Shadow_File_Name(Ft   : in out File_Type;
                                       Name : String);

-----------------------  Get_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the contents file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

        procedure Get_Contents_File_Name(Ft       : File_Type;
                                         Name     : in out String;
                                         Lastchar : in out Natural);

-----------------------  Set_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the contents file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

        procedure Set_Contents_File_Name(Ft   : in out File_Type;
                                         Name : String);

-----------------------  Get_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the intention of the node handle,
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention returned is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

        procedure Get_Intent(Ft     : File_Type;
                             Intent : in out Intention);

-----------------------  Set_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the intention of the node handle,
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention to be stored is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

        procedure Set_Intent(Ft     : in out File_Type;
                             Intent : Intention);

-----------------------  Get_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the file mode
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode returned is the mode with which the file handle
--    was opened.
--
---------------------------------------------------------------------

        procedure Get_Mode(Ft   : File_Type;
                           Mode : in out File_Mode);

-----------------------  Set_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the file mode
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode to be stored is the mode with which the file handle
--    is being opened (or reset).
--
---------------------------------------------------------------------

        procedure Set_Mode(Ft   : in out File_Type;
                           Mode : File_Mode);

-----------------------  Get_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the pathname of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname returned is the pathname from the node handle
--    through which the file handle was opened.
--
---------------------------------------------------------------------

        procedure Get_Name(Ft       : File_Type;
                           Name     : in out String;
                           Lastchar : in out Natural);

-----------------------  Set_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the pathname of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname to be stored is the pathname from the node handle
--    through which the file handle is being opened.
--
---------------------------------------------------------------------

        procedure Set_Name(Ft   : in out File_Type;
                           Name : String);

-----------------------  Get_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal function which returns the form list of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

        function Get_Form(Ft : File_Type) return List_Type;

-----------------------  Set_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure which stores the form list of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Form      list of form entries.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

        procedure Set_Form(Ft   : in out File_Type;
                           Form : List_Type);
    private

        type Function_Key_Descriptor(Length : Positive) is
            record
                Not_Implemented : Boolean := True;
            end record;

        type File_Rec is
            record
                Fd                 : Text_File_Ptr := new Standard.Text_Io.
                    File_Type;
                Shadow_File_Name   : String(1 .. Max_Shadow_File_Length);
                Contents_File_Name : String(1 .. Max_Contents_File_Length);
                Intent             : Intention(Pragmatics.Intent_Count);
                Intent_Size        : Pragmatics.Intent_Count;
                Mode               : File_Mode;
                Name               : String(1 .. Max_Name_String);
                Form               : List_Type;
            end record;

        type File_Type is access File_Rec;

-----------------------------------------------------------------------------
    end Io_Definitions;
-----------------------------------------------------------------------------

    package Io_Control is
        use Io_Definitions;
        use Node_Definitions;
        use List_Utilities;

        procedure Open_File_Node(File       : File_Type;
                                 Node       : in out Node_Type;
                                 Intent     : Intention;
                                 Time_Limit : Duration := No_Delay);
        procedure Synchronize(File : File_Type);
        procedure Set_Log(File     : File_Type;
                          Log_File : File_Type);
        procedure Clear_Log(File : File_Type);
        function Logging(File : File_Type) return Boolean;
        function Get_Log(File : File_Type) return File_Type;
        function Number_Of_Elements(File : File_Type) return Natural;
        procedure Set_Prompt(Terminal : File_Type;
                             Prompt   : String);
        function Get_Prompt(Terminal : File_Type) return String;
        function Intercepted_Characters(Terminal : File_Type) return
            Character_Array;
        procedure Enable_Function_Keys(Terminal : File_Type;
                                       Enable   : Boolean);
        function Function_Keys_Enabled(Terminal : File_Type) return Boolean;
        procedure Couple(Queue_Base     : Node_Type;
                         Queue_Key      : Relationship_Key := Latest_Key;
                         Queue_Relation : Relation_Name := Default_Relation;
                         File_Node      : Node_Type;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type;
                                            -- intentionally no default
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);
        procedure Couple(Queue_Name     : Name_String;
                         File_Node      : Node_Type;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type;
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);
        procedure Couple(Queue_Base     : Node_Type;
                         Queue_Key      : Relationship_Key := Latest_Key;
                         Queue_Relation : Relation_Name := Default_Relation;
                         File_Name      : Name_String;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type;
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);
        procedure Couple(Queue_Name     : Name_String;
                         File_Name      : Name_String;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type;
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);


    end Io_Control;

----------------------------------------------------------------------
--              D I R E C T _ I O _ D E F I N I T I O N S
--
--  Purpose:
--  -------
--      This package defines the types and exceptions associated with
--      Direct_Io file handles.
--
--  Usage:
--  -----
--    Package Cais.Direct_Io instantiates this package to produce
--    a new package Dir_Io_Definitions nested in the Cais.Direct_Io
--    specification.  For direct use of the base types and exceptions
--    used by Cais.Direct_Io, the user can refer to the instantiated
--    package.
--
--  Notes:
--  -----
--    This package  is added to the CAIS implementation
--    to provide distinct File_Types for each CAIS.Direct_Io
--    instantiation.  This is an alternative to the present
--    CAIS file handle usage, which differs substantially from
--    standard Ada Input/Output.
--    Ada generic I/O packages permit an unbounded number of
--    file types to be constructed.  The CAIS requires a single
--    file type to hide all file types, for use by  text and generic
--    instantiations of direct and sequential IO packages.
--    This implementation follows Ada.
--
--      The     use     of     a     limited     private     type
--      (Direct_Io_Definitions.File_Type)  implies  the addition of
--      subprograms to manipulate  that  type  (e.g.  to  set  or
--      extract  the  contents of an object of that type).  These
--      are in this specification, although they are additions to
--      the  CAIS  specification  for  this  package.
--
--      This is a version of the package Cais.IO_Definitions,
--      specified in MIL-STD-CAIS section 5.3.1
--
--  Revision History:
--  ----------------
--    None.
--
-------------------------------------------------------------------

    generic
        type Element_Type is private;
    package Direct_Io_Definitions is

        use Node_Definitions;
                          -- Not in Cais spec
        use Pragmatics;
                     -- Not in Cais spec
        use Io_Exceptions;
        use List_Utilities;
                        -- Not in Cais spec


        type File_Mode is (In_File, Inout_File, Out_File);

        type File_Type is limited private;


        Status_Error : exception renames Io_Exceptions.Status_Error;
        Mode_Error   : exception renames Io_Exceptions.Mode_Error;
        Name_Error   : exception renames Io_Exceptions.Name_Error;
        Use_Error    : exception renames Io_Exceptions.Use_Error;
        Device_Error : exception renames Io_Exceptions.Device_Error;
        End_Error    : exception renames Io_Exceptions.End_Error;
        Data_Error   : exception renames Io_Exceptions.Data_Error;
        Layout_Error : exception renames Io_Exceptions.Layout_Error;

    -- The following is NOT part of the CAIS specification.


        type Direct_File_Ptr is private;

----------------------- Initialize ----------------------------
--
--  Purpose:
--  -------
--    Internal function to allocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are allocated from heap.
--
---------------------------------------------------------------------

        procedure Initialize(Ft : in out File_Type);

----------------------- Deallocate ----------------------------
--
--  Purpose:
--  -------
--    Internal function to deallocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are released to heap via unchecked deallocation.
--
---------------------------------------------------------------------

        procedure Deallocate(Ft : in out File_Type);

----------------------- Un_Initialized ----------------------------
--
--  Purpose:
--  -------
--    Internal function to test whether file has been
--    initialized.  Returns True if not initialized,
--    otherwise returns False.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Handle is checked for null reference.
--
---------------------------------------------------------------------

        function Un_Initialized(Ft : File_Type) return Boolean;

----------------------- Assign ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to copy one file handle record to
--    another.
--
--  Parameters:
--  ----------
--    From    (access to) source file handle record.
--    To    (access to) target file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    If the target file handle is uninitialized, Assign initializes
--    it before copying the components of the record.
--
---------------------------------------------------------------------

        procedure Assign(From : File_Type;
                         To   : in out File_Type);
-----------------------  Get_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal function to fetch (access to) the Ada file descriptor
--    for the contents file from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Direct_Io.File_Type,
--    The access value returned is of type Direct_File_Ptr.
--
---------------------------------------------------------------------

        function Get_File_Type(Ft : File_Type) return Direct_File_Ptr;

-----------------------  Set_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store (access to) an Ada file descriptor
--    for the contents file into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--    DFD    access to the Direct_Io file descriptor.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Direct_Io.File_Type.
--    The access parameter is of type Direct_File_Ptr.
--
---------------------------------------------------------------------

        procedure Set_File_Type(Ft  : in out File_Type;
                                Dfd : Direct_File_Ptr);

-----------------------  Get_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the shadow file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

        procedure Get_Shadow_File_Name(Ft       : File_Type;
                                       Name     : in out String;
                                       Lastchar : in out Natural);

-----------------------  Set_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the shadow file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

        procedure Set_Shadow_File_Name(Ft   : in out File_Type;
                                       Name : String);

-----------------------  Get_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the contents file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

        procedure Get_Contents_File_Name(Ft       : File_Type;
                                         Name     : in out String;
                                         Lastchar : in out Natural);

-----------------------  Set_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the contents file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

        procedure Set_Contents_File_Name(Ft   : in out File_Type;
                                         Name : String);

-----------------------  Get_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the intention of the node handle,
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention returned is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

        procedure Get_Intent(Ft     : File_Type;
                             Intent : in out Intention);

-----------------------  Set_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the intention of the node handle,
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention to be stored is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

        procedure Set_Intent(Ft     : in out File_Type;
                             Intent : Intention);

-----------------------  Get_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the file mode
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode returned is the mode with which the file handle
--    was opened.
--
---------------------------------------------------------------------

        procedure Get_Mode(Ft   : File_Type;
                           Mode : in out File_Mode);

-----------------------  Set_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the file mode
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode to be stored is the mode with which the file handle
--    is being opened (or reset).
--
---------------------------------------------------------------------

        procedure Set_Mode(Ft   : in out File_Type;
                           Mode : File_Mode);

-----------------------  Get_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the pathname of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname returned is the pathname from the node handle
--    through which the file handle was opened.
--
---------------------------------------------------------------------

        procedure Get_Name(Ft       : File_Type;
                           Name     : in out String;
                           Lastchar : in out Natural);

-----------------------  Set_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the pathname of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname to be stored is the pathname from the node handle
--    through which the file handle is being opened.
--
---------------------------------------------------------------------

        procedure Set_Name(Ft   : in out File_Type;
                           Name : String);

-----------------------  Get_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal function which returns the form list of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

        function Get_Form(Ft : File_Type) return List_Type;

-----------------------  Set_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure which stores the form list of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Form      list of form entries.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

        procedure Set_Form(Ft   : in out File_Type;
                           Form : List_Type);
    private
        package Dir_Io is
            new Standard.Direct_Io(Element_Type);
        type Direct_File_Ptr is access Dir_Io.File_Type;

        type File_Rec is
            record
                Fd                 : Direct_File_Ptr := new Dir_Io.File_Type;
                Shadow_File_Name   : String(1 .. Max_Shadow_File_Length);
                Contents_File_Name : String(1 .. Max_Contents_File_Length);
                Intent             : Intention(Pragmatics.Intent_Count);
                Intent_Size        : Pragmatics.Intent_Count;
                Mode               : File_Mode;
                Name               : String(1 .. Max_Name_String);
                Form               : List_Type;
            end record;

        type File_Type is access File_Rec;

------------------------------------------------------------------------------
    end Direct_Io_Definitions;
------------------------------------------------------------------------------
----------------------------------------------------------------------
--                  D I R E C T _ I O
--
--  Purpose:
--  -------
--        This package provides facilities for direct-access input
--        and output to CAIS file comparable to those described
--        in the DIRECT_IO package of the Ada LRM.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Direct_Io
--        package.  The package is instantiated with the element
--        type of the file as parameter.  CAIS file nodes
--        correspond to ordinary Ada files, and file handles are
--        Ada objects of CAIS subtype Direct_Io.File_Type,
--        corresponding to the Ada (LRM) Direct_Io.File_Type.
--        CAIS Direct_Io input and output operations
--        access the contents of CAIS file nodes.
--
--  Notes:
--  -----
--        This is a version of the package CAIS.DIRECT_IO,
--        specified in MIL-STD-CAIS section 5.3.2; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.  This implementation deviates
--        from the CAIS specification in that a distinct type,
--        File_Type is employed in the package, following the
--        Ada LRM.  The package instantiates another generic
--        package, Direct_Io_Definitions, that supports the
--        abstract data type, File_Type.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

    generic
        type Element_Type is private;
    package Direct_Io is

        use Node_Definitions;
        use List_Utilities;

        package Dir_Io_Definitions is
            new Direct_Io_Definitions(Element_Type);
        use Dir_Io_Definitions;

        subtype File_Type is Dir_Io_Definitions.File_Type;
        subtype File_Mode is Dir_Io_Definitions.File_Mode;

        type Count is range 0 .. Integer'Last;
        subtype Positive_Count is Count range 1 .. Count'Last;

----------------------     Create     ----------------------
--
--  Purpose:
--  -------
--        This procedure creates a file and its file node; the
--        file contains elements which may be accessed either
--        directly or sequentially.  The attribute Access_Method is
--        assigned the value "(Direct,Sequential)" as part of the creation.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Base    open node handle to the node which will be the
--        source of the primary relationship to the new
--        node.
--    Key    relationship key of the primary relationship to
--        be created.
--    Relation    relation name of the primary relationship to be created.
--    Mode    indicates mode of the file.
--    Form    indicates file characteristics.
--    Attributes
--        initial values for attributes of the new node.
--    Access_Control
--        defines the initial access control information
--        associated with the created node.
--    Level    defines the classification label for the created node.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if a node already exists for the node specified
--        by Key and Relation or if Key or Relation is syntactically
--        illegal or if any node identifying a group specified in the
--        given Access_Control parameter is unobtainable.
--    Use_Error
--        raised if any of the parameters Access_Control, Level or
--        Attributes is syntactically or semantically illegal.
--        Use_Error is also raised if Relation is the name of a
--        predefined attribute other than File_Kind.  Also raised if
--        Relation is the name of a predefined relation which cannnot
--        be created by the user.
--    Status_Error
--        raised if Base is not an open node handle or if File is
--        an open file handle prior to the call.
--    Intent_Violation
--        raised if Base was not opened with an intent establishing
--        the right to append relationships.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.2.2 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Create that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

        procedure Create(File           : in out File_Type;
                         Base           : in out Node_Type;
                         Key            : Relationship_Key := Latest_Key;
                         Relation       : Relation_Name := Default_Relation;
                         Mode           : File_Mode := Inout_File;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type := Empty_List;
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);

-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

        procedure Create(File           : in out File_Type;
                         Name           : Name_String;
                         Mode           : File_Mode := Inout_File;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type := Empty_List;
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);

----------------------     Open     ----------------------
--
--  Purpose:
--  -------
--    This procedure opens a file handle on a file containing
--    elements of the generic parameter type, given an open node
--    handle on the file node.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Node    open node handle to the file node.
--    Mode    indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    Use_Error
--        raised if the attribute Access_Method of the file node
--        does not have the value Direct, the element type of the
--        file does not correspond with the element type of this
--        instantiation of the CAIS Direct_Io package, or the Mode
--        is Append_File.
--
--    Status_Error
--        raised if File is an open file handle at the time of the call
--        or if Node is not an open node handle.
--
--    Intent_Violation
--        raised if Node has not been opened with an intent
--        establishing the access rights required for the Mode.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.2.3 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Open that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

        procedure Open(File : in out File_Type;
                       Node : Node_Type;
                       Mode : File_Mode);



-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

        procedure Open(File : in out File_Type;
                       Name : Name_String;
                       Mode : File_Mode);

----------------------     Close     ----------------------
--
--  Purpose:
--  -------
--    Closes file handle to CAIS file node.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        procedure Close(File : in out File_Type);

----------------------     Delete     ----------------------
--
--  Purpose:
--  -------
--    This procedure deletes the CAIS file identified
--    by File.
--    In addition to the semantics specified in the LRM,
--    the node associated with the open file handle File
--    is made unobtainable as if a call to the Delete_Node
--    procedure had been made.
--
--  Parameters:
--  ----------
--    File    an open file handle on the file being deleted.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if the parent node of the node associated with
--        the file identified by File is inaccessible.
--    Use_Error
--        raised if any primary relationships emanate from the
--        node associated with the file identified by File.
--    Status_Error
--        raised if File is not an open file handle.
--    Lock_Error
--        raised if access with intent Write_Relationships to the
--        parent of the node to be deleted cannot be obtained due
--        to an existing lock on the node.
--    Access_Violation
--        raised if the current process does not have sufficient
--        discretionary access control rights to obtain access to
--        the parent of the node to be deleted with intent
--        Exclusive_Write; only raised if the conditions for
--        Name_Error are not present.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.2.4 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Delete(File : in out File_Type);
----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset the file mode of a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--    Mode    Indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    See note.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    Semantics of this procedure are not restricted to Ada LRM
--    semantics, pending clarification of the interaction of access
--    methods in the CAIS.
--
--    Although no exceptions are defined in the CAIS, checking of
--    Status_Error and Use_Error for invalid mode is done.
---------------------------------------------------------------------

        procedure Reset(File : in out File_Type;
                        Mode : File_Mode);
----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    Semantics of this procedure are not restricted to Ada LRM
--    semantics, pending clarification of the interaction of access
--    methods in the CAIS.
---------------------------------------------------------------------

        procedure Reset(File : in out File_Type);

----------------------     Mode     ----------------------
--
--  Purpose:
--  -------
--    Returns the current mode of the current CAIS file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Mode(File : File_Type) return File_Mode;
----------------------     Name     ----------------------
--
--  Purpose:
--  -------
--    Returns a string containing the name of the CAIS file
--    node currently associated with the file handle.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Name(File : File_Type) return String;
----------------------     Form     ----------------------
--
--  Purpose:
--  -------
--    Returns the form string for the external file currently
--    associated with the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Form(File : File_Type) return String;

----------------------     Is_Open     ----------------------
--
--  Purpose:
--  -------
--    Returns TRUE if the file handle is open, otherwise returns FALSE.
--
--  Parameters:
--  ----------
--    File    file handle.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Is_Open(File : File_Type) return Boolean;

---------------------------     Read     ---------------------------
--
--  Purpose:
--  -------
--    Sets the current index of the given file to the index
--    value given by the parameter From.
--    Returns in the parameter Item, the value of the element
--    whose position in the given file is specified by the
--    current index of the file; then increases the current
--    index by one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    returns element read from file.
--    From    index of element to be read.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if the mode is not In_File.
--    End_Error
--        raised if the index to be used exceeds the size
--        of the given file.
--    Data_Error
--        raised if the element read cannot be interpreted
--        as a value of the generic parameter type.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

        procedure Read(File : File_Type;
                       Item : in out Element_Type;
                       From : Positive_Count);

---------------------------     Read     ---------------------------
--
--  Purpose:
--  -------
--    Returns in the parameter Item, the value of the element
--    whose position in the given file is specified by the
--    current index of the file; then increases the current
--    index by one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    returns element read from file.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if the mode is not In_File.
--    End_Error
--        raised if the index to be used exceeds the size
--        of the given file.
--    Data_Error
--        raised if the element read cannot be interpreted
--        as a value of the generic parameter type.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

        procedure Read(File : File_Type;
                       Item : in out Element_Type);

---------------------------     Write     ---------------------------
--
--  Purpose:
--  -------
--    Sets the index of the given file to the index value given
--    by the parameter To.
--    Gives the value of the parameter Item to the element whose
--    position in the given file is specified by the current index
--    of the file; then increases the current index by one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    element to be written to the file.
--    To    index of element to be written.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if mode is In_File.
--    Use_Error
--        raised if the capacity of the file is exceeded.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

        procedure Write(File : File_Type;
                        Item : Element_Type;
                        To   : Positive_Count);

---------------------------     Write     ---------------------------
--
--  Purpose:
--  -------
--    Gives the value of the parameter Item to the element whose
--    position in the given file is specified by the current index
--    of the file; then increases the current index by one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    element to be written to the file.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if mode is In_File.
--    Use_Error
--        raised if the capacity of the file is exceeded.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

        procedure Write(File : File_Type;
                        Item : Element_Type);

----------------------     Set_Index     ----------------------
--
--  Purpose:
--  -------
--    Sets the current index of the given file to the given
--    index value (which may exceed the current size of the file).
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    index value.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

        procedure Set_Index(File : File_Type;
                            To   : Positive_Count);
----------------------     Index     ----------------------
--
--  Purpose:
--  -------
--    Returns the current index of the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

        function Index(File : File_Type) return Positive_Count;

----------------------     Size     ----------------------
--
--  Purpose:
--  -------
--    Returns the current size of the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

        function Size(File : File_Type) return Count;

----------------------     End_Of_File     ----------------------
--
--  Purpose:
--  -------
--    Returns True if the current index is exceeds the size of the
--    given file;  otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if file mode is Out_File.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.4.
--
---------------------------------------------------------------------

        function End_Of_File(File : File_Type) return Boolean;

---------------------------------------------------------------------
    end Direct_Io;
---------------------------------------------------------------------

----------------------------------------------------------------------
--          S E Q U E N T I A L _ I O _ D E F I N I T I O N S
--
--  Purpose:
--  -------
--      This package defines the types and exceptions associated with
--      sequential_io file handles.
--
--  Usage:
--  -----
--    Package Cais.Sequential_Io instantiates this package to produce
--    a new package Seq_Io_Definitions nested in the Cais.Sequential_Io
--    specification.  For direct use of the base types and exceptions
--    used by Cais.Sequential_Io, the user can refer to the instantiated
--    package.
--
--  Notes:
--  -----
--    This package  is added to the CAIS implementation
--    to provide distinct File_Types for each CAIS.Sequential_Io
--    instantiation.  This is an alternative to the present
--    CAIS file handle usage, which differs substantially from
--    standard Ada Input/Output.
--    Ada generic I/O packages permit an unbounded number of
--    file types to be constructed.  The CAIS requires a single
--    file type to hide all file types, for use by  text and generic
--    instantiations of direct and sequential IO packages.
--    This implementation follows Ada.
--
--      The     use     of     a     limited     private     type
--      (Sequential_Io_Definitions.File_Type)  implies  the addition of
--      subprograms to manipulate  that  type  (e.g.  to  set  or
--      extract  the  contents of an object of that type).  These
--      are in this specification, although they are additions to
--      the  CAIS  specification  for  this  package.
--
--      This is a version of the package Cais.IO_Definitions,
--      specified in MIL-STD-CAIS section 5.3.1
--
--  Revision History:
--  ----------------
--    None.
--
-------------------------------------------------------------------

    generic
        type Element_Type is private;
    package Sequential_Io_Definitions is

        use Node_Definitions;
                          -- Not in Cais spec
        use Pragmatics;
                     -- Not in Cais spec
        use Io_Exceptions;
        use List_Utilities;
                        -- Not in Cais spec


        type File_Mode is (In_File, Inout_File, Out_File, Append_File);

        type File_Type is limited private;


        Status_Error : exception renames Io_Exceptions.Status_Error;
        Mode_Error   : exception renames Io_Exceptions.Mode_Error;
        Name_Error   : exception renames Io_Exceptions.Name_Error;
        Use_Error    : exception renames Io_Exceptions.Use_Error;
        Device_Error : exception renames Io_Exceptions.Device_Error;
        End_Error    : exception renames Io_Exceptions.End_Error;
        Data_Error   : exception renames Io_Exceptions.Data_Error;
        Layout_Error : exception renames Io_Exceptions.Layout_Error;

    -- The following is NOT part of the CAIS specification.


        type Sequential_File_Ptr is private;

----------------------- Initialize ----------------------------
--
--  Purpose:
--  -------
--    Internal function to allocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are allocated from heap.
--
---------------------------------------------------------------------

        procedure Initialize(Ft : in out File_Type);

----------------------- Deallocate ----------------------------
--
--  Purpose:
--  -------
--    Internal function to deallocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are released to heap via unchecked deallocation.
--
---------------------------------------------------------------------

        procedure Deallocate(Ft : in out File_Type);

----------------------- Un_Initialized ----------------------------
--
--  Purpose:
--  -------
--    Internal function to test whether file has been
--    initialized.  Returns True if not initialized,
--    otherwise returns False.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Handle is checked for null reference.
--
---------------------------------------------------------------------

        function Un_Initialized(Ft : File_Type) return Boolean;

----------------------- Assign ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to copy one file handle record to
--    another.
--
--  Parameters:
--  ----------
--    From    (access to) source file handle record.
--    To    (access to) target file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    If the target file handle is uninitialized, Assign initializes
--    it before copying the components of the record.
--
---------------------------------------------------------------------

        procedure Assign(From : File_Type;
                         To   : in out File_Type);
-----------------------  Get_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal function to fetch (access to) the Ada file descriptor
--    for the contents file from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Sequential_Io.File_Type,
--    The access value returned is of type Sequential_File_Ptr.
--
---------------------------------------------------------------------

        function Get_File_Type(Ft : File_Type) return Sequential_File_Ptr;

-----------------------  Set_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store (access to) an Ada file descriptor
--    for the contents file into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--    SFD    access to the Sequential_Io file descriptor.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Sequential_Io.File_Type.
--    The access parameter is of type Sequential_File_Ptr.
--
---------------------------------------------------------------------

        procedure Set_File_Type(Ft  : in out File_Type;
                                Sfd : Sequential_File_Ptr);

-----------------------  Get_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the shadow file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

        procedure Get_Shadow_File_Name(Ft       : File_Type;
                                       Name     : in out String;
                                       Lastchar : in out Natural);

-----------------------  Set_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the shadow file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

        procedure Set_Shadow_File_Name(Ft   : in out File_Type;
                                       Name : String);

-----------------------  Get_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the contents file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

        procedure Get_Contents_File_Name(Ft       : File_Type;
                                         Name     : in out String;
                                         Lastchar : in out Natural);

-----------------------  Set_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the contents file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

        procedure Set_Contents_File_Name(Ft   : in out File_Type;
                                         Name : String);

-----------------------  Get_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the intention of the node handle,
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention returned is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

        procedure Get_Intent(Ft     : File_Type;
                             Intent : in out Intention);

-----------------------  Set_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the intention of the node handle,
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention to be stored is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

        procedure Set_Intent(Ft     : in out File_Type;
                             Intent : Intention);

-----------------------  Get_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the file mode
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode returned is the mode with which the file handle
--    was opened.
--
---------------------------------------------------------------------

        procedure Get_Mode(Ft   : File_Type;
                           Mode : in out File_Mode);

-----------------------  Set_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the file mode
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode to be stored is the mode with which the file handle
--    is being opened (or reset).
--
---------------------------------------------------------------------

        procedure Set_Mode(Ft   : in out File_Type;
                           Mode : File_Mode);

-----------------------  Get_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the pathname of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname returned is the pathname from the node handle
--    through which the file handle was opened.
--
---------------------------------------------------------------------

        procedure Get_Name(Ft       : File_Type;
                           Name     : in out String;
                           Lastchar : in out Natural);

-----------------------  Set_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the pathname of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname to be stored is the pathname from the node handle
--    through which the file handle is being opened.
--
---------------------------------------------------------------------

        procedure Set_Name(Ft   : in out File_Type;
                           Name : String);

-----------------------  Get_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal function which returns the form list of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

        function Get_Form(Ft : File_Type) return List_Type;

-----------------------  Set_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure which stores the form list of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Form      list of form entries.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

        procedure Set_Form(Ft   : in out File_Type;
                           Form : List_Type);
    private
        package Seq_Io is
            new Standard.Sequential_Io(Element_Type);
        type Sequential_File_Ptr is access Seq_Io.File_Type;

        type File_Rec is
            record
                Fd                 : Sequential_File_Ptr := new Seq_Io.File_Type
                    ;
                Shadow_File_Name   : String(1 .. Max_Shadow_File_Length);
                Contents_File_Name : String(1 .. Max_Contents_File_Length);
                Intent             : Intention(Pragmatics.Intent_Count);
                Intent_Size        : Pragmatics.Intent_Count;
                Mode               : File_Mode;
                Name               : String(1 .. Max_Name_String);
                Form               : List_Type;
            end record;

        type File_Type is access File_Rec;

----------------------------------------------------------------------------
    end Sequential_Io_Definitions;
----------------------------------------------------------------------------
----------------------------------------------------------------------
--              S E Q U E N T I A L _ I O
--
--  Purpose:
--  -------
--        This package provides facilities for sequentially accessing
--        data elements in CAIS files.  These facilities are comparable
--        to those described in the SEQUENTIAL_IO package of the Ada LRM.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Sequential_Io
--        package.  The package is instantiated with the element
--        type of the file as parameter.  CAIS file nodes
--        correspond to ordinary Ada files, and file handles are
--        Ada objects of CAIS subtype Sequential_Io.File_Type,
--        corresponding to Ada (LRM) Sequential_Io.File_Type.
--        CAIS Sequential_Io input and output operations
--        access the contents of CAIS file nodes.
--
--  Notes:
--  -----
--        This is a version of the package CAIS.SEQUENTIAL_IO,
--        specified in MIL-STD-CAIS section 5.3.3; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.  This implementation deviates
--        from the CAIS specification in that a distinct type,
--        File_Type is employed in the package, following the
--        Ada LRM.  The package instantiates another generic
--        package, Sequential_Io_Definitions, that supports the
--        abstract data type, File_Type.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

    generic
        type Element_Type is private;
    package Sequential_Io is

        use Node_Definitions;
        use List_Utilities;

        package Seq_Io_Definitions is
            new Sequential_Io_Definitions(Element_Type);
        use Seq_Io_Definitions;

        subtype File_Type is Seq_Io_Definitions.File_Type;
        subtype File_Mode is Seq_Io_Definitions.File_Mode;


----------------------     Create     ----------------------
--
--  Purpose:
--  -------
--        This procedure creates a file and its file node; the
--        file contains elements which may be accessed either
--        sequentially.  The attribute Access_Method is
--        assigned the value "(Sequential)" as part of the creation.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Base    open node handle to the node which will be the
--        source of the primary relationship to the new
--        node.
--    Key    relationship key of the primary relationship to
--        be created.
--    Relation    relation name of the primary relationship to be created.
--    Mode    indicates mode of the file.
--    Form    indicates file characteristics.
--    Attributes
--        initial values for attributes of the new node.
--    Access_Control
--        defines the initial access control information
--        associated with the created node.
--    Level    defines the classification label for the created node.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if a node already exists for the node specified
--        by Key and Relation or if Key or Relation is syntactically
--        illegal or if any node identifying a group specified in the
--        given Access_Control parameter is unobtainable.
--    Use_Error
--        raised if any of the parameters Access_Control, Level or
--        Attributes is syntactically or semantically illegal.
--        Use_Error is also raised if Relation is the name of a
--        predefined attribute other than File_Kind.  Also raised if
--        Relation is the name of a predefined relation which cannnot
--        be created by the user.
--    Status_Error
--        raised if Base is not an open node handle or if File is
--        an open file handle prior to the call.
--    Intent_Violation
--        raised if Base was not opened with an intent establishing
--        the right to append relationships.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.3.2 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Create that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

        procedure Create(File           : in out File_Type;
                         Base           : in out Node_Type;
                         Key            : Relationship_Key := Latest_Key;
                         Relation       : Relation_Name := Default_Relation;
                         Mode           : File_Mode := Inout_File;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type := Empty_List;
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);



-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

        procedure Create(File           : in out File_Type;
                         Name           : Name_String;
                         Mode           : File_Mode := Inout_File;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type := Empty_List;
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);


----------------------     Open     ----------------------
--
--  Purpose:
--  -------
--    This procedure opens a file handle on a file containing
--    elements of the generic parameter type, given an open node
--    handle on the file node.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Node    open node handle to the file node.
--    Mode    indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    Use_Error
--        raised if the attribute Access_Method of the file node
--        does not have the value Sequential or the element type of the
--        file does not correspond with the element type of this
--        instantiation of the CAIS Sequential_Io package.
--
--        also raised if the node identified by Node has a value of
--        Queue for the attribute File_Kind and a value of Mimic for
--        the attribute Queue_Kind and the mimic queue file identified
--        by File is being opened with Mode other than In_File but the
--        coupled file has been deleted.
--
--    Status_Error
--        raised if File is an open file handle at the time of the call
--        or if Node is not an open node handle.
--
--    Intent_Violation
--        raised if Node has not been opened with an intent
--        establishing the access rights required for the Mode.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.3.3 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Open that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

        procedure Open(File : in out File_Type;
                       Node : Node_Type;
                       Mode : File_Mode);


-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

        procedure Open(File : in out File_Type;
                       Name : Name_String;
                       Mode : File_Mode);

----------------------     Close     ----------------------
--
--  Purpose:
--  -------
--    Closes file handle to CAIS file node.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        procedure Close(File : in out File_Type);

----------------------     Delete     ----------------------
--
--  Purpose:
--  -------
--    This procedure deletes the CAIS file identified
--    by File.
--    In addition to the semantics specified in the LRM,
--    the node associated with the open file handle File
--    is made unobtainable as if a call to the Delete_Node
--    procedure had been made.
--
--  Parameters:
--  ----------
--    File    an open file handle on the file being deleted.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if the parent node of the node associated with
--        the file identified by File is inaccessible.
--    Use_Error
--        raised if any primary relationships emanate from the
--        node associated with the file identified by File.
--    Status_Error
--        raised if File is not an open file handle.
--    Lock_Error
--        raised if access with intent Write_Relationships to the
--        parent of the node to be deleted cannot be obtained due
--        to an existing lock on the node.
--    Access_Violation
--        raised if the current process does not have sufficient
--        discretionary access control rights to obtain access to
--        the parent of the node to be deleted with intent
--        Exclusive_Write; only raised if the conditions for
--        Name_Error are not present.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.3.4 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Delete(File : in out File_Type);

----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset the file mode of a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--    Mode    Indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    See note.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    Semantics of this procedure are not restricted to Ada LRM
--    semantics, pending clarification of the interaction of access
--    methods in the CAIS.
--
--    Although no exceptions are defined in the CAIS, checking of
--    Status_Error and Use_Error for invalid mode is done.
---------------------------------------------------------------------

        procedure Reset(File : in out File_Type;
                        Mode : File_Mode);
----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    Semantics of this procedure are not restricted to Ada LRM
--    semantics, pending clarification of the interaction of access
--    methods in the CAIS.
---------------------------------------------------------------------

        procedure Reset(File : in out File_Type);

----------------------     Mode     ----------------------
--
--  Purpose:
--  -------
--    Returns the current mode of the current CAIS file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Mode(File : File_Type) return File_Mode;
----------------------     Name     ----------------------
--
--  Purpose:
--  -------
--    Returns a string containing the name of the CAIS file
--    node currently associated with the file handle.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Name(File : File_Type) return String;
----------------------     Form     ----------------------
--
--  Purpose:
--  -------
--    Returns the form string for the external file currently
--    associated with the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Form(File : File_Type) return String;

----------------------     Is_Open     ----------------------
--
--  Purpose:
--  -------
--    Returns TRUE if the file handle is open, otherwise returns FALSE.
--
--  Parameters:
--  ----------
--    File    file handle.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Is_Open(File : File_Type) return Boolean;


---------------------------     Read     ---------------------------
--
--  Purpose:
--  -------
--    Reads an element from the given file, and returns the value
--    of this element in the Item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    returns element read from file.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if the mode is not In_File.
--    End_Error
--        raised if no more elements can be read from the
--        given file.
--    Data_Error
--        raised if the element read cannot be interpreted
--        as a value of the generic parameter type.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.2.
--
---------------------------------------------------------------------

        procedure Read(File : File_Type;
                       Item : in out Element_Type);
---------------------------     Write     ---------------------------
--
--  Purpose:
--  -------
--    Writes the value of Item to the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    element to be written to the file.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if mode is not Out_File.
--    Use_Error
--        raised if the capacity of the file is exceeded.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.2.
--
---------------------------------------------------------------------

        procedure Write(File : File_Type;
                        Item : Element_Type);

----------------------     End_Of_File     ----------------------
--
--  Purpose:
--  -------
--    Returns True if no more elements can be read from the
--    given file;  otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--
--  Notes:
--  -----
--    Semantics follow Ada LRM Section 14.2.2.
--
---------------------------------------------------------------------

        function End_Of_File(File : File_Type) return Boolean;

---------------------------------------------------------------------
    end Sequential_Io;
---------------------------------------------------------------------

----------------------------------------------------------------------
--                     T E X T _ I O
--
--  Purpose:
--  -------
--        This package comprises the CAIS Input/Output operations
--        on text files, which correspond to those in Ada LRM
--        Chapter 14 I/O.  Input and output operations access
--        the contents of CAIS file nodes.  Generic packages
--        for text input/output of integer, enumeration, fixed and
--        float types are nested in CAIS Text_Io, as they are in
--        Ada (Ch. 14) I/O.  Additional interfaces to manage Standard
--        and Current Error files are provided.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Text_Io package.
--        CAIS file nodes correspond to ordinary Ada files, and
--        file handles are Ada objects of type CAIS Text_Io.File_Type,
--        rather than Ada (LRM) Text_Io.File_Type.
--
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

    package Text_Io is

        use Node_Definitions;
        use List_Utilities;
        use Cais.Io_Definitions;

        type Count is range 0 .. Integer'Last;

        subtype Positive_Count is Count range 1 .. Count'Last;

        Unbounded : constant Count := 0;
                                     --Line and page length

        subtype Field is Integer range 0 .. Integer'Last;
        subtype Number_Base is Integer range 2 .. 16;

        type Type_Set is (Lower_Case, Upper_Case);

--MIL STD 5.3.4.1
        subtype File_Type is Cais.Io_Definitions.File_Type;
        subtype File_Mode is Cais.Io_Definitions.File_Mode;

--not in CAIS, additional interface

        In_File     : constant File_Mode := Cais.Io_Definitions.In_File;
        Inout_File  : constant File_Mode := Cais.Io_Definitions.Inout_File;
        Out_File    : constant File_Mode := Cais.Io_Definitions.Out_File;
        Append_File : constant File_Mode := Cais.Io_Definitions.Append_File;



----------------------     Create     ----------------------
--
--  Purpose:
--  -------
--        This procedure creates a file and its file node; the
--        file is textual.  The attribute Access_Method is
--        assigned the value "(Text)" as part of the creation.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Base    open node handle to the node which will be the
--        source of the primary relationship to the new
--        node.
--    Key    relationship key of the primary relationship to
--        be created.
--    Relation    relation name of the primary relationship to be created.
--    Mode    indicates mode of the file.
--    Form    indicates file characteristics.
--    Attributes
--        initial values for attributes of the new node.
--    Access_Control
--        defines the initial access control information
--        associated with the created node.
--    Level    defines the classification label for the created node.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if a node already exists for the node specified
--        by Key and Relation or if Key or Relation is syntactically
--        illegal or if any node identifying a group specified in the
--        given Access_Control parameter is unobtainable.
--    Use_Error
--        raised if any of the parameters Access_Control, Level or
--        Attributes is syntactically or semantically illegal.
--        Use_Error is also raised if Relation is the name of a
--        predefined attribute other than File_Kind.  Also raised if
--        Relation is the name of a predefined relation which cannnot
--        be created by the user.
--    Status_Error
--        raised if Base is not an open node handle or if File is
--        an open file handle prior to the call.
--    Intent_Violation
--        raised if Base was not opened with an intent establishing
--        the right to append relationships.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.2 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Create that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

        procedure Create(File           : in out File_Type;
                         Base           : in out Node_Type;
                         Key            : Relationship_Key := Latest_Key;
                         Relation       : Relation_Name := Default_Relation;
                         Mode           : File_Mode := Inout_File;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type := Empty_List;
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);


-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

        procedure Create(File           : in out File_Type;
                         Name           : Name_String;
                         Mode           : File_Mode := Inout_File;
                         Form           : List_Type := Empty_List;
                         Attributes     : List_Type := Empty_List;
                         Access_Control : List_Type := Empty_List;
                         Level          : List_Type := Empty_List);


----------------------     Open     ----------------------
--
--  Purpose:
--  -------
--    This procedure opens a file handle on a file that
--    has textual content, given an open node handle on
--    the file node.
--
--  Parameters:
--  ----------
--    File    file handle, initially closed, to be opened.
--    Node    open node handle to the file node.
--    Mode    indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    Use_Error
--        raised if the attribute Access_Method of the file node
--        does not have the value Text or the element type of the
--        file does not correspond with the element type of this
--        instantiation of the CAIS Text_Io package.
--
--        also raised if the node identified by Node has a value of
--        Queue for the attribute File_Kind and a value of Mimic for
--        the attribute Queue_Kind and the mimic queue file identified
--        by File is being opened with Mode other than In_File but the
--        coupled file has been deleted.
--
--        also raised if the node identified by Node has a value of
--        Terminal or Magnetic_Tape for the attribute File_Kind and the
--        Mode is Append_File.
--    Status_Error
--        raised if File is an open file handle at the time of the call
--        or if Node is not an open node handle.
--    Intent_Violation
--        raised if Node has not been opened with an intent
--        establishing the access rights required for the Mode.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.3 of MIL-STD-CAIS,
--    dated 31 January 1985.
--    The additional interface for Open that is presented is
--    also provided.
--    NOTE:  The exception handler semantics of the additional
--    interface are not adequate.  The unconditional Close file
--    call may raise a Status_Error, causing the original
--    exception to be lost.
--
---------------------------------------------------------------------

        procedure Open(File : in out File_Type;
                       Node : Node_Type;
                       Mode : File_Mode);


-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

        procedure Open(File : in out File_Type;
                       Name : Name_String;
                       Mode : File_Mode);

----------------------     Close     ----------------------
--
--  Purpose:
--  -------
--    Closes file handle to CAIS file node.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        procedure Close(File : in out File_Type);

----------------------     Delete     ----------------------
--
--  Purpose:
--  -------
--    This procedure deletes the CAIS file identified
--    by File.
--    In addition to the semantics specified in the LRM,
--    the node associated with the open file handle File
--    is made unobtainable as if a call to the Delete_Node
--    procedure had been made.
--
--  Parameters:
--  ----------
--    File    an open file handle on the file being deleted.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if the parent node of the node associated with
--        the file identified by File is inaccessible.
--    Use_Error
--        raised if any primary relationships emanate from the
--        node associated with the file identified by File.
--    Status_Error
--        raised if File is not an open file handle.
--    Lock_Error
--        raised if access with intent Write_Relationships to the
--        parent of the node to be deleted cannot be obtained due
--        to an existing lock on the node.
--    Access_Violation
--        raised if the current process does not have sufficient
--        discretionary access control rights to obtain access to
--        the parent of the node to be deleted with intent
--        Exclusive_Write; only raised if the conditions for
--        Name_Error are not present.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls; raised only if the conditions for other
--        exceptions are not present.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.4 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Delete(File : in out File_Type);
----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--
--  Exceptions:
--  ----------
--    Use_Error
--        raised if the node associated with the file identified
--        by File has a value of Terminal or Magnetic_Tape for
--        the attribute File_Kind and the Mode is Append_File.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
---------------------------------------------------------------------

        procedure Reset(File : in out File_Type);
----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset the file mode of a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--    Mode    Indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    Use_Error
--        raised if the node associated with the file identified
--        by File has a value of Terminal or Magnetic_Tape for
--        the attribute File_Kind and the Mode is Append_File.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
---------------------------------------------------------------------

        procedure Reset(File : in out File_Type;
                        Mode : File_Mode);

----------------------     Mode     ----------------------
--
--  Purpose:
--  -------
--    Returns the current mode of the current CAIS file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Mode(File : File_Type) return File_Mode;
----------------------     Name     ----------------------
--
--  Purpose:
--  -------
--    Returns a string containing the name of the CAIS file
--    node currently associated with the file handle.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Name(File : File_Type) return String;
----------------------     Form     ----------------------
--
--  Purpose:
--  -------
--    Returns the form string for the external file currently
--    associated with the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Form(File : File_Type) return String;

----------------------     Is_Open     ----------------------
--
--  Purpose:
--  -------
--    Returns TRUE if the file handle is open, otherwise returns FALSE.
--
--  Parameters:
--  ----------
--    File    file handle.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

        function Is_Open(File : File_Type) return Boolean;


----------------------     Set_Input     ----------------------
--
--  Purpose:
--  -------
--    Sets the current default input file to File.
--    In addition to the semantics specified in the Ada LRM, the
--    file node associated with the file identified by File becomes
--    the target of the relationship of the predefined relation
--    Current_Input of the current process node.
--
--  Parameters:
--  ----------
--    File    an open file handle.
--
--  Exceptions:
--  ----------
--    Mode_Error
--        raised if the mode of the file identified by File
--        is Out_File or Append_File.
--    Status_Error
--        raised if File is not an open file handle.
--    Lock_Error
--        raised if the current process node is locked against
--        writing relationships.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.8 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Set_Input(File : File_Type);

----------------------     Set_Output     ----------------------
--
--  Purpose:
--  -------
--    Sets the current default output file to File.
--    In addition to the semantics specified in the Ada LRM, the
--    file node associated with the file identified by File becomes
--    the target of the relationship of the predefined relation
--    Current_Output of the current process node.
--
--  Parameters:
--  ----------
--    File    an open file handle.
--
--  Exceptions:
--  ----------
--    Mode_Error
--        raised if the mode of the file identified by File
--        is In_File
--    Status_Error
--        raised if File is not an open file handle.
--    Lock_Error
--        raised if the current process node is locked against
--        writing relationships.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.9 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Set_Output(File : File_Type);

----------------------     Set_Error     ----------------------
--
--  Purpose:
--  -------
--    Sets the current default error file to File.  The
--    file node associated with the file identified by File becomes
--    the target of the relationship of the predefined relation
--    Current_Error of the current process node.
--
--  Parameters:
--  ----------
--    File    an open file handle.
--
--  Exceptions:
--  ----------
--    Mode_Error
--        raised if the mode of the file identified by File
--        is In_File
--    Status_Error
--        raised if File is not an open file handle.
--    Lock_Error
--        raised if the current process node is locked against
--        writing relationships.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.9 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Set_Error(File : File_Type);

----------------------     Standard_Input     ----------------------
--
--  Purpose:
--  -------
--    This function returns an open file handle to the target node
--    of the relationship of the predefined relation Standard_Input
--    that was set at the start of program execution.
--
--  Parameters:
--  ----------
--    None.
--
--  Exceptions:
--  ----------
--    Lock_Error
--        raised if the current process node is locked against
--        reading relationships.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.11 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        function Standard_Input return File_Type;

----------------------     Standard_Output     ----------------------
--
--  Purpose:
--  -------
--    This function returns an open file handle to the target node
--    of the relationship of the predefined relation Standard_Output
--    that was set at the start of program execution.
--
--  Parameters:
--  ----------
--    None.
--
--  Exceptions:
--  ----------
--    Lock_Error
--        raised if the current process node is locked against
--        reading relationships.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.11 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        function Standard_Output return File_Type;

----------------------     Standard_Error     ----------------------
--
--  Purpose:
--  -------
--    This function returns an open file handle to the target node
--    of the relationship of the predefined relation Standard_Error
--    that was set at the start of program execution.
--
--  Parameters:
--  ----------
--    None.
--
--  Exceptions:
--  ----------
--    Lock_Error
--        raised if the current process node is locked against
--        reading relationships.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.11 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        function Standard_Error return File_Type;

----------------------     Current_Input     ----------------------
--
--  Purpose:
--  -------
--    This function returns an open file handle to the target node
--    of the relationship of the predefined relation Current_Input
--    which is either the standard input file or the file specified
--    in the most recent invocation of Set_Input in the current process.
--
--  Parameters:
--  ----------
--    None.
--
--  Exceptions:
--  ----------
--    Lock_Error
--        raised if the current process node is locked against
--        reading relationships.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.12 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        function Current_Input return File_Type;

----------------------     Current_Output     ----------------------
--
--  Purpose:
--  -------
--    This function returns an open file handle to the target node
--    of the relationship of the predefined relation Current_Output
--    which is either the standard output file or the file specified
--    in the most recent invocation of Set_Output in the current process.
--
--  Parameters:
--  ----------
--    None.
--
--  Exceptions:
--  ----------
--    Lock_Error
--        raised if the current process node is locked against
--        reading relationships.
--
--  Notes:
--  -----
--    This procedure is defined as in section 5.3.4.12 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        function Current_Output return File_Type;

----------------------     Current_Error     ----------------------
--
--  Purpose:
--  -------
--    This function returns an open file handle to the target node
--    of the relationship of the predefined relation Current_Error
--    which is either the standard error file or the file specified
--    in the most recent invocation of Set_Error in the current process.
--
--  Parameters:
--  ----------
--    None.
--
--  Exceptions:
--  ----------
--    Lock_Error
--        raised if the current process node is locked against
--        reading relationships.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.12 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        function Current_Error return File_Type;


----------------------     Set_Line_Length     ----------------------
--
--  Purpose:
--  -------
--    Sets the maximum line length of the specified output file to the
--    number of characters specified by To.  The value 0 for To specifies an
--    unbounded line length.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    number to which bound is to be set.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--    Use_Error
--        raised if the specified line length is inappropriate for
--        the associated external file.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.3
--
---------------------------------------------------------------------

        procedure Set_Line_Length(File : File_Type;
                                  To   : Count);
        procedure Set_Line_Length(To : Count);

----------------------     Set_Page_Length     ----------------------
--
--  Purpose:
--  -------
--    Sets the maximum page length of the specified output file to the
--    number of lines specified by To.  The value 0 for To specifies an
--    unbounded page length.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    number to which bound is to be set.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--    Use_Error
--        raised if the specified page length is inappropriate for
--        the associated external file.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.3
--
---------------------------------------------------------------------

        procedure Set_Page_Length(File : File_Type;
                                  To   : Count);
        procedure Set_Page_Length(To : Count);


----------------------     Line_Length     ----------------------
--
--  Purpose:
--  -------
--    Returns the line length currently set for the specified output file,
--    or zero if the line length is unbounded.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.3
--
---------------------------------------------------------------------

        function Line_Length(File : File_Type) return Count;
        function Line_Length return Count;


----------------------     Page_Length     ----------------------
--
--  Purpose:
--  -------
--    Returns the page length currently set for the specified output file,
--    or zero if the page length is unbounded.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.3
--
---------------------------------------------------------------------

        function Page_Length(File : File_Type) return Count;
        function Page_Length return Count;


----------------------     New_Line     ----------------------
--
--  Purpose:
--  -------
--    Outputs a line terminator and sets the current column
--    number to one.  Increments line number or if line
--    number exceeds maximum line for bounded page length,
--    outputs a page terminator, increments page number,
--    and sets line number to one.
--
--  Parameters:
--  ----------
--    File      open file handle.
--    Spacing   number of times New_Line action is performed.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        procedure New_Line(File    : File_Type;
                           Spacing : Positive_Count := 1);
        procedure New_Line(Spacing : Positive_Count := 1);

----------------------     Skip_Line     ----------------------
--
--  Purpose:
--  -------
--    Reads and discards all characters until a line terminator has
--    been read.  Then sets the current column number to one.
--
--  Parameters:
--  ----------
--    File      open file handle.
--    Spacing   number of times Skip_Line action is to be performed.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--    End_Error
--        raised if attempt is made to read a file terminator.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        procedure Skip_Line(File    : File_Type;
                            Spacing : Positive_Count := 1);
        procedure Skip_Line(Spacing : Positive_Count := 1);

----------------------     End_Of_Line     ----------------------
--
--  Purpose:
--  -------
--    Returns True if a line terminator or a file terminator
--    is next; otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        function End_Of_Line(File : File_Type) return Boolean;
        function End_Of_Line return Boolean;

----------------------     New_Page     ----------------------
--
--  Purpose:
--  -------
--    Outputs a line terminator if the current line is not
--    terminated or current page is empty.  Outputs a page
--    terminator and adds one to current page number. Sets
--    the current column and line numbers to one.
--
--  Parameters:
--  ----------
--    File      open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        procedure New_Page(File : File_Type);
        procedure New_Page;

----------------------     Skip_Page     ----------------------
--
--  Purpose:
--  -------
--    Reads and discards all characters until a page terminator has
--    been read.  Then adds one to the current page number and
--    sets the current column number and line numbers to one.
--
--  Parameters:
--  ----------
--    File      open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--    End_Error
--        raised if attempt is made to read a file terminator.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        procedure Skip_Page(File : File_Type);
        procedure Skip_Page;

----------------------     End_Of_Page     ----------------------
--
--  Purpose:
--  -------
--    Returns True if a line terminator and a page terminator
--    or a file terminator is next; otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        function End_Of_Page(File : File_Type) return Boolean;
        function End_Of_Page return Boolean;

----------------------     End_Of_File     ----------------------
--
--  Purpose:
--  -------
--    Returns True if a file terminator or the combination of a line
--    terminator, page terminator, and a file terminator
--    is next; otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        function End_Of_File(File : File_Type) return Boolean;
        function End_Of_File return Boolean;


----------------------     Set_Col     ----------------------
--
--  Purpose:
--  -------
--    If mode is Out_File, outputs spaces until current column
--    equals To.  If To is less than current column, a New_Line
--    is performed first.
--
--    If mode is In_File, discards characters until next character
--    has column equal to To.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    column number.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if mode is Out_File and To exceeds maximum
--        line length.
--    End_Error
--        raised if attempt is made to read file terminator.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        procedure Set_Col(File : File_Type;
                          To   : Positive_Count);
        procedure Set_Col(To : Positive_Count);


----------------------     Set_Line     ----------------------
--
--  Purpose:
--  -------
--    If mode is Out_File, performs New_Line until current line
--    equals To.  If To is less than current line, a New_Page
--    is performed first.
--
--    If mode is In_File, performs Skip_Line until current line number
--    is equal to To.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    column number.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if mode is Out_File and To exceeds maximum
--        page length.
--    End_Error
--        raised if attempt is made to read file terminator.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        procedure Set_Line(File : File_Type;
                           To   : Positive_Count);
        procedure Set_Line(To : Positive_Count);

----------------------     Col     ----------------------
--
--  Purpose:
--  -------
--    Returns the current column number.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Layout_Error
--        raised if this number exceeds Count'Last.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        function Col(File : File_Type) return Positive_Count;
        function Col return Positive_Count;

----------------------     Line     ----------------------
--
--  Purpose:
--  -------
--    Returns the current line number.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Layout_Error
--        raised if this number exceeds Count'Last.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        function Line(File : File_Type) return Positive_Count;
        function Line return Positive_Count;

----------------------     Page     ----------------------
--
--  Purpose:
--  -------
--    Returns the current page number.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Layout_Error
--        raised if this number exceeds Count'Last.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

        function Page(File : File_Type) return Positive_Count;
        function Page return Positive_Count;



----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file into the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of type Character.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Get(File : File_Type;
                      Item : in out Character);
        procedure Get(Item : in out Character);

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of type Character.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Put(File : File_Type;
                      Item : Character);
        procedure Put(Item : Character);

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file into the item parameter.
--    The number of Get character operations is determined by
--    the length of the string.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of type String.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Get(File : File_Type;
                      Item : in out String);
        procedure Get(Item : in out String);

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified file.
--    The number of Put character operations is determined by
--    the length of the string.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of type String.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

        procedure Put(File : File_Type;
                      Item : String);
        procedure Put(Item : String);

----------------------     Get_Line     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads successive characters from the specified
--    text file into the item parameter.  Reading stops if the end
--    of line is met.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of type String.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.6.
--
---------------------------------------------------------------------

        procedure Get_Line(File : File_Type;
                           Item : in out String;
                           Last : in out Natural);
        procedure Get_Line(Item : in out String;
                           Last : in out Natural);

----------------------     Put_Line     ----------------------
--
--  Purpose:
--  -------
--    This procedure calls procedure Put for the given string,
--    then New_Line, with a spacing of one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of type String.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.6
--
---------------------------------------------------------------------

        procedure Put_Line(File : File_Type;
                           Item : String);
        procedure Put_Line(Item : String);

----------------------------------------------------------------------
--              C A I S _ T E X T _ I O . I N T E G E R _ I O
--
--  Purpose:
--  -------
--        Integer_Io is a generic package nested in the CAIS Text_Io package.
--        This package provides facilities for the input and output
--        of textual integer data to CAIS files.  These facilities are
--        comparable to those specified in the package TEXT_IO.INTEGER_IO
--        in the Ada LRM, Chapter 14.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Text_Io.Integer_Io package.
--        CAIS file nodes correspond to ordinary Ada files.
--        Input and output operations access the contents of CAIS
--        file nodes.
--        The package is instantiated for the element type.  File_Type
--        and File_Mode are subtypes declared in the Cais.Text_Io package.
--
--  Example:
--  -------
--        type Small_Integer is range 1..20;
--        ...
--        File      : File_Type;
--        package Small_Io is new Cais.Text_Io.Integer_Io (Small_Integer);
--        ...
--        Small_Io.Put (File, 15);
--        ...
--
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO.INTEGER_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

        generic
            type Num is range <>;
        package Integer_Io is

            Default_Width : Field := Num'Width;
            Default_Base  : Number_Base := 10;

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file, according to the syntax of a literal
--    of the parameter type,
--    and stores the converted value in the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of the generic parameter type.
--    Width    field width, or 0 if unbounded.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

            procedure Get(File  : File_Type;
                          Item  : in out Num;
                          Width : Field := 0);


            procedure Get(Item  : in out Num;
                          Width : Field := 0);

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes the value of Item, represented as a literal
--    of the parameter type, to the specified file.
--
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of the generic parameter type.
--    Width    minimum field width.
--    Base    base for literal representation.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.7 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

            procedure Put(File  : File_Type;
                          Item  : Num;
                          Width : Field := Default_Width;
                          Base  : Number_Base := Default_Base);


            procedure Put(Item  : Num;
                          Width : Field := Default_Width;
                          Base  : Number_Base := Default_Base);

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    string into the item parameter, following the same
--    rule as for reading from a file, but treating the
--    end of the string as a file terminator.
--
--  Parameters:
--  ----------
--    From    string.
--    Item    out parameter of the generic parameter type.
--    Last    index value of last character read.
--
--  Exceptions:
--  ----------
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.7
--
---------------------------------------------------------------------

            procedure Get(From : String;
                          Item : in out Num;
                          Last : in out Positive);

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified string,
--    following the same rule as for output to a file.
--
--  Parameters:
--  ----------
--    To    string.
--    Item    in parameter of generic parameter type.
--    Base    base for literal representation.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the remaining string length.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.7
--
---------------------------------------------------------------------

            procedure Put(To   : in out String;
                          Item : Num;
                          Base : Number_Base := Default_Base);

        end Integer_Io;



----------------------------------------------------------------------
--              C A I S _ T E X T _ I O . F L O A T _ I O
--
--  Purpose:
--  -------
--        Float_Io is a generic package nested in the CAIS Text_Io package.
--        This package provides facilities for the input and output
--        of textual float data to CAIS files.  These facilities are
--        comparable to those specified in the package TEXT_IO.FLOAT_IO
--        in the Ada LRM, Chapter 14.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Text_Io.Float_Io package.
--        CAIS file nodes correspond to ordinary Ada files.
--        Input and output operations access the contents of CAIS
--        file nodes.
--        The package is instantiated for the element type.  File_Type
--        and File_Mode are subtypes declared in the Cais.Text_Io package.
--
--  Example:
--  -------
--        type Real_Float is digits 5 range 0.0000 .. 9.9999;
--        ...
--        File      : File_Type;
--        package Real_Io is new Cais.Text_Io.Float_Io (Real_Float);
--        ...
--        Real_Io.Put (File, 2.3456);
--        ...
--
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO.FLOAT_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

        generic
            type Num is digits <>;
        package Float_Io is

            Default_Fore : Field := 2;
            Default_Aft  : Field := Num'digits - 1;
            Default_Exp  : Field := 3;


----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file, according to the syntax of a literal
--    of the parameter type,
--    and stores the converted value in the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of the generic parameter type.
--    Width    field width, or 0 if unbounded.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

            procedure Get(File  : File_Type;
                          Item  : in out Num;
                          Width : Field := 0);

            procedure Get(Item  : in out Num;
                          Width : Field := 0);

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes the value of Item, represented as a literal
--    of the parameter type, to the specified file.
--
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of the generic parameter type.
--    Width    minimum field width.
--    Fore    digits before decimal in literal representation.
--    Aft    digits after decimal in literal representation.
--    Exp    digits in exponent in literal representation.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.7 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------


            procedure Put(File : File_Type;
                          Item : Num;
                          Fore : Field := Default_Fore;
                          Aft  : Field := Default_Aft;
                          Exp  : Field := Default_Exp);

            procedure Put(Item : Num;
                          Fore : Field := Default_Fore;
                          Aft  : Field := Default_Aft;
                          Exp  : Field := Default_Exp);

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    string into the item parameter, following the same
--    rule as for reading from a file, but treating the
--    end of the string as a file terminator.
--
--  Parameters:
--  ----------
--    From    string.
--    Item    out parameter of the generic parameter type.
--    Last    index value of last character read.
--
--  Exceptions:
--  ----------
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.7
--
---------------------------------------------------------------------

            procedure Get(From : String;
                          Item : in out Num;
                          Last : in out Positive);

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified string,
--    following the same rule as for output to a file.
--    The number of digits before the exponent is adjusted so
--    that the literal exactly fills the string.
--
--  Parameters:
--  ----------
--    To    string.
--    Item    in parameter of generic parameter type.
--    Aft    digits after the decimal in the literal representation.
--    Exp    digits in the exponent in the literal representation.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the remaining string length.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.7
--
---------------------------------------------------------------------

            procedure Put(To   : in out String;
                          Item : Num;
                          Aft  : Field := Default_Aft;
                          Exp  : Field := Default_Exp);

        end Float_Io;

----------------------------------------------------------------------
--              C A I S _ T E X T _ I O . F I X E D _ I O
--
--  Purpose:
--  -------
--        Fixed_Io is a generic package nested in the CAIS Text_Io package.
--        This package provides facilities for the input and output
--        of textual Fixed data to CAIS files.  These facilities are
--        comparable to those specified in the package TEXT_IO.FIXED_IO
--        in the Ada LRM, Chapter 14.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Text_Io.Fixed_Io package.
--        CAIS file nodes correspond to ordinary Ada files.
--        Input and output operations access the contents of CAIS
--        file nodes.
--        The package is instantiated for the element type.  File_Type
--        and File_Mode are subtypes declared in the Cais.Text_Io package.
--
--  Example:
--  -------
--        type Real_Fixed is delta 0.001 range 0.000 .. 9.999;
--        ...
--        File      : File_Type;
--        package Real_Io is new Cais.Text_Io.Fixed_Io (Real_Fixed);
--        ...
--        Real_Io.Put (File, 5.432);
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO.FIXED_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

        generic
            type Num is delta <>;
        package Fixed_Io is

            Default_Fore : Field := Num'Fore;
            Default_Aft  : Field := Num'Aft;
            Default_Exp  : Field := 0;


----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file, according to the syntax of a literal
--    of the parameter type,
--    and stores the converted value in the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of the generic parameter type.
--    Width    field width, or 0 if unbounded.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

            procedure Get(File  : File_Type;
                          Item  : in out Num;
                          Width : Field := 0);

            procedure Get(Item  : in out Num;
                          Width : Field := 0);


----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes the value of Item, represented as a literal
--    of the parameter type, to the specified file.
--
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of the generic parameter type.
--    Width    minimum field width.
--    Fore    digits before decimal in literal representation.
--    Aft    digits after decimal in literal representation.
--    Exp    digits in exponent in literal representation.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.7 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

            procedure Put(File : File_Type;
                          Item : Num;
                          Fore : Field := Default_Fore;
                          Aft  : Field := Default_Aft;
                          Exp  : Field := Default_Exp);

            procedure Put(Item : Num;
                          Fore : Field := Default_Fore;
                          Aft  : Field := Default_Aft;
                          Exp  : Field := Default_Exp);

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    string into the item parameter, following the same
--    rule as for reading from a file, but treating the
--    end of the string as a file terminator.
--
--  Parameters:
--  ----------
--    From    string.
--    Item    out parameter of the generic parameter type.
--    Last    index value of last character read.
--
--  Exceptions:
--  ----------
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.8
--
---------------------------------------------------------------------

            procedure Get(From : String;
                          Item : in out Num;
                          Last : in out Positive);

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified string,
--    following the same rule as for output to a file.
--    The number of digits before the exponent is adjusted so
--    that the literal exactly fills the string.
--
--  Parameters:
--  ----------
--    To    string.
--    Item    in parameter of generic parameter type.
--    Aft    digits after the decimal in the literal representation.
--    Exp    digits in the exponent in the literal representation.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the remaining string length.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.8
--
---------------------------------------------------------------------

            procedure Put(To   : in out String;
                          Item : Num;
                          Aft  : Field := Default_Aft;
                          Exp  : Field := Default_Exp);

        end Fixed_Io;

----------------------------------------------------------------------
--              C A I S _ T E X T _ I O . E N U M E R A T I O N _ I O
--
--  Purpose:
--  -------
--        Enumeration_Io is a generic package nested in the CAIS Text_Io package.
--        This package provides facilities for the input and output
--        of textual enumeration data to CAIS files.  These facilities are
--        comparable to those specified in the package TEXT_IO.ENUMERATION_IO
--        in the Ada LRM, Chapter 14.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Text_Io.Enumeration_Io package.
--        CAIS file nodes correspond to ordinary Ada files.
--        Input and output operations access the contents of CAIS
--        file nodes.
--        The package is instantiated for the element type.  File_Type
--        and File_Mode are subtypes declared in the Cais.Text_Io package.
--
--  Example:
--  -------
--        type Color is (Red, Yellow, Blue);
--        package Hue_Io is new Cais.Text_Io.Enumeration_Io (Color);
--        ...
--        File : File_Type;
--        ...
--        Hue_Io.Put (File, Blue);
--        ...
--
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO.ENUMERATION_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

        generic
            type Enum is (<>);
        package Enumeration_Io is

            Default_Width   : Field := 0;
            Default_Setting : Type_Set := Upper_Case;

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file, according to the syntax of a literal
--    of the parameter type,
--    and stores the converted value in the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of the generic parameter type.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

            procedure Get(File : File_Type;
                          Item : in out Enum);

            procedure Get(Item : in out Enum);

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes the value of Item, represented as a literal
--    of the parameter type, to the specified file.
--
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of the generic parameter type.
--    Width    minimum field width.
--    Set    character set.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.7 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

            procedure Put(File  : File_Type;
                          Item  : Enum;
                          Width : Field := Default_Width;
                          Set   : Type_Set := Default_Setting);

            procedure Put(Item  : Enum;
                          Width : Field := Default_Width;
                          Set   : Type_Set := Default_Setting);

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    string into the item parameter, following the same
--    rule as for reading from a file, but treating the
--    end of the string as a file terminator.
--
--  Parameters:
--  ----------
--    From    string.
--    Item    out parameter of the generic parameter type.
--    Last    index value of last character read.
--
--  Exceptions:
--  ----------
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.9
--
---------------------------------------------------------------------

            procedure Get(From : String;
                          Item : in out Enum;
                          Last : in out Positive);

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified string,
--    following the same rule as for output to a file.
--    The number of digits before the exponent is adjusted so
--    that the literal exactly fills the string.
--
--  Parameters:
--  ----------
--    To    string.
--    Item    in parameter of generic parameter type.
--    Set    character set.
--
--  Exceptions:
--  ----------
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the remaining string length.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.9
--
---------------------------------------------------------------------

            procedure Put(To   : in out String;
                          Item : Enum;
                          Set  : Type_Set := Default_Setting);

        end Enumeration_Io;

-----------------------------------------------------------------------------
    end Text_Io;
-----------------------------------------------------------------------------

----------------------------------------------------------------------
--                     S C R O L L _ T E R M I N A L
--
--  Purpose:
--  -------
--    This package provides the functionality of a scroll terminal.
--    A scroll terminal consists of two devices: an input device
--    (keyboard) and an associated output device (a printer or display).
--    A scroll terminal may be accesses either as a single file of mode
--    "Inout_File" or as two files: one of mode "In_File" (the keyboard)
--    and the other of mode "Out_File" (the printer or display).  As keys
--    pressed on the scroll terminal keyboard, the transmitted characters
--    are made available for reading by the CAIS Scroll_Terminal package.
--    As characters are written to the scroll terminal file, they are
--    displayed on the output device.
--
--  Usage:
--  -----
--    One of the advantages of Scroll_Terminal over Text_Io for interactive
--    I/O is that Scroll_Terminal provides some very useful host-independent
--    terminal control facilities.  For example, enabling and disabling
--    echo at the terminal is available.  Text_Io.Get is NOT required to
--    provide an unbuffered single character Get; this is available in
--    Scroll_Terminal.
--
--  Example:
--  -------
--    TBS
--
--  Notes:
--  -----
--    None.
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------

    package Scroll_Terminal is

        use Cais.Io_Definitions;
        use Node_Definitions;

        subtype File_Type is Cais.Io_Definitions.File_Type;
        subtype Function_Key_Descriptor is Cais.Io_Definitions.
            Function_Key_Descriptor;
        subtype Position_Type is Cais.Io_Definitions.Position_Type;
        subtype Tab_Eumeration is Cais.Io_Definitions.Tab_Enumeration;

        procedure Set_Position(Terminal : File_Type;
                               Position : Position_Type);
        procedure Set_Position(Position : Position_Type);
        function Get_Position(Terminal : File_Type) return Position_Type;
        function Get_Position return Position_Type;
        function Terminal_Size(Terminal : File_Type) return Position_Type;
        function Terminal_Size return Position_Type;
        procedure Set_Tab(Terminal : File_Type;
                          Kind     : Tab_Enumeration := Horizontal);
        procedure Set_Tab(Kind : Tab_Enumeration := Horizontal);
        procedure Clear_Tab(Terminal : File_Type;
                            Kind     : Tab_Enumeration := Horizontal);
        procedure Clear_Tab(Kind : Tab_Enumeration := Horizontal);
        procedure Tab(Terminal : File_Type;
                      Kind     : Tab_Enumeration := Horizontal;
                      Count    : Positive := 1);
        procedure Tab(Kind  : Tab_Enumeration := Horizontal;
                      Count : Positive := 1);
        procedure Bell(Terminal : File_Type);
        procedure Bell;
        procedure Put(Terminal : File_Type;
                      Item     : Character);
        procedure Put(Item : Character);
        procedure Put(Terminal : File_Type;
                      Item     : String);
        procedure Put(Item : String);
        procedure Set_Echo(Terminal : File_Type;
                           To       : Boolean := True);
        procedure Set_Echo(To : Boolean := True);
        function Echo(Terminal : File_Type) return Boolean;
        function Echo return Boolean;
        function Maximum_Function_Key(Terminal : File_Type) return Natural;
        function Maximum_Function_Key return Natural;
        procedure Get(Terminal : File_Type;
                      Item     : in out Character;
                      Keys     : in out Function_Key_Descriptor);
        procedure Get(Item : in out Character;
                      Keys : in out Function_Key_Descriptor);
        procedure Get(Terminal : File_Type;
                      Item     : in out String;
                      Last     : in out Natural;
                      Keys     : in out Function_Key_Descriptor);
        procedure Get(Item : in out String;
                      Last : in out Natural;
                      Keys : in out Function_Key_Descriptor);
        function Function_Key_Count(Keys : Function_Key_Descriptor) return
            Natural;
        procedure Function_Key(Keys           : Function_Key_Descriptor;
                               Index          : Positive;
                               Key_Identifier : in out Positive;
                               Position       : in out Natural);
        procedure Function_Key_Name(Terminal       : File_Type;
                                    Key_Identifier : Positive;
                                    Key_Name       : in out String;
                                    Last           : in out Positive);
        procedure Function_Key_Name(Key_Identifier : Positive;
                                    Key_Name       : in out String;
                                    Last           : in out Positive);
        procedure New_Line(Terminal : File_Type;
                           Count    : Positive := 1);
        procedure New_Line(Count : Positive := 1);
        procedure New_Page(Terminal : File_Type);
        procedure New_Page;

    end Scroll_Terminal;

    package Page_Terminal is
        use Node_Definitions;
        use Io_Definitions;
        use Io_Control;
        subtype File_Type is Cais.Io_Definitions.File_Type;
        subtype Function_Key_Descriptor is Cais.Io_Definitions.
            Function_Key_Descriptor;
        subtype Position_Type is Cais.Io_Definitions.Position_Type;
        subtype Tab_Enumeration is Cais.Io_Definitions.Tab_Enumeration;

        type Select_Enumeration is (From_Active_Position_To_End,
            From_Start_To_Active_Position, All_Positions);
        type Graphic_Rendition_Enumeration is (Primary_Rendition, Bold, Faint,
            Underscore, Slow_Blink, Rapid_Blink, Reverse_Image);
        type Graphic_Rendition_Array is array(Graphic_Rendition_Enumeration) of
            Boolean;

        Default_Graphic_Rendition : constant Graphic_Rendition_Array := (True,
            False, False, False, False, False, False);

        procedure Set_Position(Terminal : File_Type;
                               Position : Position_Type);
        procedure Set_Position(Position : Position_Type);
        function Get_Position(Terminal : File_Type) return Position_Type;
        function Get_Position return Position_Type;
        function Terminal_Size(Terminal : File_Type) return Position_Type;
        function Terminal_Size return Position_Type;
        procedure Set_Tab(Terminal : File_Type;
                          Kind     : Tab_Enumeration := Horizontal);
        procedure Set_Tab(Kind : Tab_Enumeration := Horizontal);
        procedure Clear_Tab(Terminal : File_Type;
                            Kind     : Tab_Enumeration := Horizontal);
        procedure Clear_Tab(Kind : Tab_Enumeration := Horizontal);
        procedure Tab(Terminal : File_Type;
                      Kind     : Tab_Enumeration := Horizontal;
                      Count    : Positive := 1);
        procedure Tab(Kind  : Tab_Enumeration := Horizontal;
                      Count : Positive := 1);
        procedure Bell(Terminal : File_Type);
        procedure Bell;
        procedure Put(Terminal : File_Type;
                      Item     : Character);
        procedure Put(Item : Character);
        procedure Put(Terminal : File_Type;
                      Item     : String);
        procedure Put(Item : String);
        procedure Set_Echo(Terminal : File_Type;
                           To       : Boolean := True);
        procedure Set_Echo(To : Boolean := True);
        function Echo(Terminal : File_Type) return Boolean;
        function Echo return Boolean;
        function Maximum_Function_Key(Terminal : File_Type) return Natural;
        function Maximum_Function_Key return Natural;
        procedure Get(Terminal : File_Type;
                      Item     : in out Character;
                      Keys     : in out Function_Key_Descriptor);
        procedure Get(Item : in out Character;
                      Keys : in out Function_Key_Descriptor);
        procedure Get(Terminal : File_Type;
                      Item     : in out String;
                      Last     : in out Natural;
                      Keys     : in out Function_Key_Descriptor);
        procedure Get(Item : in out String;
                      Last : in out Natural;
                      Keys : in out Function_Key_Descriptor);
        function Function_Key_Count(Keys : Function_Key_Descriptor) return
            Natural;
        procedure Function_Key(Keys           : Function_Key_Descriptor;
                               Index          : Positive;
                               Key_Identifier : in out Positive;
                               Position       : in out Natural);
        procedure Function_Key_Name(Terminal       : File_Type;
                                    Key_Identifier : Positive;
                                    Key_Name       : in out String;
                                    Last           : in out Positive);
        procedure Function_Key_Name(Key_Identifier : Positive;
                                    Key_Name       : in out String;
                                    Last           : in out Positive);
        procedure Delete_Character(Terminal : File_Type;
                                   Count    : Positive := 1);
        procedure Delete_Character(Count : Positive := 1);
        procedure Delete_Line(Terminal : File_Type;
                              Count    : Positive := 1);
        procedure Delete_Line(Count : Positive := 1);
        procedure Erase_Character(Terminal : File_Type;
                                  Count    : Positive := 1);
        procedure Erase_Character(Count : Positive := 1);
        procedure Erase_In_Display(Terminal  : File_Type;
                                   Selection : Select_Enumeration);
        procedure Erase_In_Display(Selection : Select_Enumeration);
        procedure Erase_In_Line(Terminal  : File_Type;
                                Selection : Select_Enumeration);
        procedure Erase_In_Line(Selection : Select_Enumeration);
        procedure Insert_Space(Terminal : File_Type;
                               Count    : Positive := 1);
        procedure Insert_Space(Count : Positive := 1);
        procedure Insert_Line(Terminal : File_Type;
                              Count    : Positive := 1);
        procedure Insert_Line(Count : Positive := 1);
        function Graphic_Rendition_Support(Terminal  : File_Type;
                                           Rendition : Graphic_Rendition_Array)
            return Boolean;
        function Graphic_Rendition_Support(Rendition : Graphic_Rendition_Array)
            return Boolean;
        procedure Select_Graphic_Rendition(Terminal  : File_Type;
                                           Rendition : Graphic_Rendition_Array
                                               := Default_Graphic_Rendition);
        procedure Select_Graphic_Rendition(Rendition : Graphic_Rendition_Array
                                               := Default_Graphic_Rendition);

    end Page_Terminal;

    package Form_Terminal is
        use Node_Definitions;
        use Io_Definitions;
        use Io_Control;
        subtype File_Type is Cais.Io_Definitions.File_Type;

        type Area_Intensity is (None, Normal, High);
        type Area_Protection is (Unprotected, Protected);
        type Area_Input is (Graphic_Characters, Numerics, Alphabetics);
        type Area_Value is (No_Fill, Fill_With_Zeroes, Fill_With_Spaces);

        type Form_Type(Row                           : Positive;
                       Column                        : Positive;
                       Area_Qualifier_Requires_Space : Boolean) is private;

        subtype Printable_Character is Character range ' ' .. '~';


        function Maximum_Function_Key(Terminal : File_Type) return Natural;
        function Maximum_Function_Key return Natural;
        procedure Define_Qualified_Area(Form       : in out Form_Type;
                                        Intensity  : Area_Intensity := Normal;
                                        Protection : Area_Protection :=
                                            Protected;
                                        Input      : Area_Input :=
                                            Graphic_Characters;
                                        Value      : Area_Value := No_Fill);
        procedure Remove_Area_Qualifier(Form : in out Form_Type);
        procedure Set_Position(Form     : in out Form_Type;
                               Position : Position_Type);
        procedure Next_Qualified_Area(Form  : in out Form_Type;
                                      Count : Positive := 1);
        procedure Put(Form : in out Form_Type;
                      Item : Printable_Character);
        procedure Put(Form : in out Form_Type;
                      Item : String);
        procedure Erase_Area(Form : in out Form_Type);
        procedure Erase_Form(Form : in out Form_Type);
        procedure Activate(Terminal : File_Type;
                           Form     : in out Form_Type);
        procedure Get(Form : in out Form_Type;
                      Item : in out Printable_Character);
        procedure Get(Form : in out Form_Type;
                      Item : in out String);
        function Is_Form_Updated(Form : Form_Type) return Boolean;
        function Termination_Key(Form : Form_Type) return Natural;
        function Form_Size(Form : Form_Type) return Position_Type;
        function Terminal_Size(Terminal : File_Type) return Position_Type;
        function Terminal_Size return Position_Type;
        function Area_Qualifier_Requires_Space(Form : Form_Type) return Boolean
            ;
        function Area_Qualifier_Requires_Space(Terminal : File_Type) return
            Boolean;
        function Area_Qualifier_Requires_Space return Boolean;


    private

        type Form_Type(Row                           : Positive;
                       Column                        : Positive;
                       Area_Qualifier_Requires_Space : Boolean) is
            record
                null; -- should be defined by implementor
            end record;

    end Form_Terminal;


    package Magnetic_Tape is
        use Node_Definitions;
        use Io_Definitions;

        type Tape_Position is (Beginning_Of_Tape, Physical_End_Of_Tape,
            Tape_Mark, Other);

        subtype Volume_String is String(1 .. 6);
        subtype File_String is String(1 .. 17);
        subtype Reel_Name is String;
        subtype File_Type is Cais.Io_Definitions.File_Type;
        subtype Label_String is String(1 .. 80);

        procedure Mount(Tape_Drive : File_Type;
                        Tape_Name  : Reel_Name;
                        Density    : Positive);
        procedure Load_Unlabeled(Tape_Drive : File_Type;
                                 Density    : Positive;
                                 Block_Size : Positive);
        procedure Initialize_Unlabeled(Tape_Drive : File_Type;
                                       Density    : Positive;
                                       Block_Size : Positive);
        procedure Load_Labeled(Tape_Drive        : File_Type;
                               Volume_Identifier : Volume_String;
                               Density           : Positive;
                               Block_Size        : Positive);
        procedure Initialize_Labeled(Tape_Drive        : File_Type;
                                     Volume_Identifier : Volume_String;
                                     Density           : Positive;
                                     Block_Size        : Positive;
                                     Accessibility     : Character := ' ');
        procedure Unload(Tape_Drive : File_Type);
        procedure Dismount(Tape_Drive : File_Type);
        function Is_Loaded(Tape_Drive : File_Type) return Boolean;
        function Is_Mounted(Tape_Drive : File_Type) return Boolean;
        function Tape_Status(Tape_Drive : File_Type) return Tape_Position;
        procedure Rewind_Tape(Tape_Drive : File_Type);
        procedure Skip_Tape_Marks(Tape_Drive : File_Type;
                                  Number     : Integer := 1;
                                  Tape_State : in out Tape_Position);
        procedure Write_Tape_Mark(Tape_Drive : File_Type;
                                  Number     : Positive := 1;
                                  Tape_State : in out Tape_Position);
        procedure Volume_Header(Tape_Drive        : File_Type;
                                Volume_Identifier : Volume_String;
                                Accessibility     : Character := ' ');
        procedure File_Header(Tape_Drive      : File_Type;
                              File_Identifier : File_String;
                              Expiration_Date : String := " 99366";
                              Accessibility   : Character := ' ');
        procedure End_File_Label(Tape_Drive : File_Type);
        procedure Read_Label(Tape_Drive : File_Type;
                             Label      : in out Label_String);



    end Magnetic_Tape;
----------------------------------------------------------------------
--               F I L E _ I M P O R T _ E X P O R T
--
--  Purpose:
--  -------
--        The CAIS allows a particular CAIS implementation to
--        maintain files separately from files maintained by
--        the host file system.  This package provides the
--        capability to transfer files between these two systems.
--
--  Usage:
--  -----
--        The operations contained in this package are
--        Import which transfers a file from the host file
--        system into a CAIS file node, and Export which
--        transfers the contents of a CAIS file node to a
--        host file.
--
--  Notes:
--  -----
--        This is a version of the package CAIS.FILE_IMPORT_EXPORT,
--        specified in MIL-STD-CAIS section 5.3.10; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

    package File_Import_Export is

        use Node_Definitions;

----------------------     Import     ----------------------
--
--  Purpose:
--  -------
--    This procedure searches for a file in the host file system
--    named Host_File_Name and copies its contents into a CAIS
--    file which is the contents of the node identified by Node.
--
--  Parameters:
--  ----------
--    Node        open node handle on the file node.
--    Host_File_Name    name of the host file to be copied.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if the node identified by Node is inaccessible.
--    Use_Error
--        raised if Host_File_Name noes not adhere to the
--        required syntax for file names in the host file system
--        or if Host_File_Name does not exist in the host file
--        system.
--
--        also raised if File is not the value of the attribute
--        Kind of the node identified by Node.
--    Status_Error
--        raised if Node is not an open node handle.
--    Intent_Violation
--        raised if Node was not opened with an intent establishing
--        the right to write contents.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls.  Security_Violation is raised only if the
--        conditions for other exceptions are not present.
--
--  Notes:
--  -----
--    Semantics are defined in cais_MIL-STD Section 5.3.10.1
--
---------------------------------------------------------------------

        procedure Import(Node           : in out Node_Type;
                         Host_File_Name : in String);


-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

        procedure Import(Name           : in Name_String;
                         Host_File_Name : in String);


----------------------     Export     ----------------------
--
--  Purpose:
--  -------
--    This procedure creates a new file named Host_File_Name in
--    the host file system and copies the contents of the file
--    node identified by Node into it.
--
--  Parameters:
--  ----------
--    Node        open node handle on the file node.
--    Host_File_Name    name of the host file to be created.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if the node identified by Node is inaccessible.
--    Use_Error
--        raised if Host_File_Name noes not adhere to the
--        required syntax for file names in the host file system
--        or if Host_File_Name cannot be created in the host file
--        system.
--
--        also raised if File is not the value of the attribute
--        Kind of the node identified by Node.
--    Status_Error
--        raised if Node is not an open node handle.
--    Intent_Violation
--        raised if Node was not opened with an intent establishing
--        the right to read contents.
--
--  Notes:
--  -----
--    Semantics are defined in cais_MIL-STD Section 5.3.10.2
--
---------------------------------------------------------------------

        procedure Export(Node           : in out Node_Type;
                         Host_File_Name : in String);


-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

        procedure Export(Name           : in Name_String;
                         Host_File_Name : in String);

----------------------------------------------------------------------------
    end File_Import_Export;

-- Not in CAIS interface

    procedure Add_User;
    procedure Delete_User;

----------------------------------------------------------------------------

private         -- all of private portion is implementation-specific.

    -- Node_Type_Record is defined in the CAIS package body
    type Node_Rec;
    type Node_Type is access Node_Rec;

end Cais;
--::::::::::::::
--cais_text_io_body.a
--::::::::::::::


----------------------------------------------------------------------
--                      T E X T _ I O
--                 (Package Body)
--
--               Procedure and Function Bodies for the
--            CAIS Text_Io Access Method
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--            Wed Oct  9 11:03:56 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--                      T E X T _ I O
--
--  Purpose:
--  -------
--        This package comprises the CAIS Input/Output operations
--        on text files, which correspond to those in Ada LRM
--        Chapter 14 I/O.  Input and output operations access
--        the contents of CAIS file nodes.  Generic packages
--        for text input/output of integer, enumeration, fixed and
--        float types are nested in CAIS Text_Io, as they are in
--        Ada (Ch. 14) I/O.  Additional interfaces to manage Standard
--        and Current Error files are provided.
--
--  Usage:
--  -----
--        Usage is analogous to usage of the Ada Text_Io package.
--        CAIS file nodes correspond to ordinary Ada files, and
--        file handles are Ada objects of type CAIS Text_Io.File_Type,
--        rather than Ada (LRM) Text_Io.File_Type.
--
--  Notes:
--  -----
--        This is a version of the package CAIS.TEXT_IO,
--        specified in MIL-STD-CAIS section 5.3.4; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------

with Text_Io;


separate(Cais)
package body Text_Io is

    use Node_Definitions;
    use Node_Management;
    use Node_Internals;
    use List_Utilities;
    use Cais_Utilities;
    use Io_Definitions;
    use Trace;
    use Identifier_Items;

    type Mode_Array is array(Positive range <>) of File_Mode;

                                        --File handles for pseudo standard
                                        -- and current input, output, and
                                        -- error files
    Cais_Standard_Input      : File_Type;
    Cais_Standard_Output     : File_Type;
    Cais_Standard_Error      : File_Type;
    Cais_Current_Input       : File_Type;
    Cais_Current_Output      : File_Type;
    Cais_Current_Error       : File_Type;
                                        -- Variable for recording open status
                                        --   of standard/current files
    File_Environment_Is_Open : Boolean := False;



--------------------------- Establish_File_Environment ------------------------
--
--    Local procedure which stubs the initialization of standard and
--    current input for the "current process."
--
-------------------------------------------------------------------------------

    procedure Establish_File_Environment is
    begin
        Initialize(Cais_Standard_Input);
        Initialize(Cais_Standard_Output);
        Initialize(Cais_Standard_Error);
        Initialize(Cais_Current_Input);
        Initialize(Cais_Current_Output);
        Initialize(Cais_Current_Error);

        Set_Contents_File_Name(Cais_Standard_Input, "/dev/tty");
        Set_Contents_File_Name(Cais_Standard_Output, "/dev/tty");
        Set_Contents_File_Name(Cais_Standard_Error, "/dev/tty");
        Set_Contents_File_Name(Cais_Current_Input, "/dev/tty");
        Set_Contents_File_Name(Cais_Current_Output, "/dev/tty");
        Set_Contents_File_Name(Cais_Current_Error, "/dev/tty");

        Standard.Text_Io.Open(Get_File_Type(Cais_Standard_Input).all, Standard.
            Text_Io.In_File, "/dev/tty");
        Standard.Text_Io.Open(Get_File_Type(Cais_Standard_Output).all, Standard.
            Text_Io.Out_File, "/dev/tty");
        Standard.Text_Io.Open(Get_File_Type(Cais_Standard_Error).all, Standard.
            Text_Io.Out_File, "/dev/tty");
        Standard.Text_Io.Open(Get_File_Type(Cais_Current_Input).all, Standard.
            Text_Io.In_File, "/dev/tty");
        Standard.Text_Io.Open(Get_File_Type(Cais_Current_Output).all, Standard.
            Text_Io.Out_File, "/dev/tty");
        Standard.Text_Io.Open(Get_File_Type(Cais_Current_Error).all, Standard.
            Text_Io.Out_File, "/dev/tty");

        File_Environment_Is_Open := True;
    end Establish_File_Environment;


---------------------------    Check_Open    --------------------------------
--
--    Local procedure which checks that file has required status
--
-------------------------------------------------------------------------------

    procedure Check_Open(File            : File_Type;
                         Required_Result : Boolean) is
    begin
        if (Is_Open(File) /= Required_Result) then
            raise Cais.Io_Definitions.Status_Error;
        end if;
    end Check_Open;

---------------------------    Check_Open    --------------------------------
--
--    Local procedure which checks that node has required status
--
-------------------------------------------------------------------------------

    procedure Check_Open(Node            : Cais.Node_Type;
                         Required_Result : Boolean) is
    begin
        if (Is_Open(Node) /= Required_Result) then
            raise Node_Definitions.Status_Error;
        end if;
    end Check_Open;


---------------------------    Check_Not_Mode    --------------------------------
--
--    Local procedure which checks that mode is not in array of
--    excluded modes
--
-------------------------------------------------------------------------------

    procedure Check_Not_Mode(File      : File_Type;
                             Bad_Modes : Mode_Array) is
    begin
        for I in Bad_Modes'range loop
            if Bad_Modes(I) = Mode(File) then
                raise Mode_Error;
            end if;
        end loop;
    end Check_Not_Mode;



---------------------------- Validate_Mode -----------------------------------
--
--    Local procedure which checks that Mode and intent of file_node
--    specified by File are consistent, and determines corresponding
--    Text_Io File_Mode.
--
-------------------------------------------------------------------------------


    procedure Validate_Mode(File     : File_Type;
                            Mode     : File_Mode;
                            Textmode : in out Standard.Text_Io.File_Mode) is
        Intent   : Intention(Pragmatics.Intent_Count);
        Intended : Intention(1 .. 2);
    begin
                                                        --Determine mode and
                                                        --check intentions
        Get_Intent(File, Intent);
        case Mode is
            when Cais.Text_Io.In_File =>
                Textmode := Standard.Text_Io.In_File;
                Check_Intentions(Intent, Read_Contents);
            when Cais.Text_Io.Out_File =>
                Textmode := Standard.Text_Io.Out_File;
                Check_Intentions(Intent, Write_Contents);
            when Cais.Text_Io.Inout_File =>
                Textmode := Standard.Text_Io.Out_File;
                Check_Intentions(Intent, (1 => Read_Contents, 2 =>
                    Write_Contents));
            when Cais.Text_Io.Append_File =>
                Textmode := Standard.Text_Io.Out_File;
                Check_Intentions(Intent, Append_Contents);
        end case;

    end Validate_Mode;

---------------------------- Set_For_Append -----------------------------------
--
--    Local procedure which positions a file opened in Append_File
--    mode.
--
-------------------------------------------------------------------------------

    procedure Set_For_Append(File : in out File_Type) is separate;

--------------------------------------------------------------------------
--
--    Separate procedure Create
--
--------------------------------------------------------------------------

    procedure Create(File           : in out File_Type;
                     Base           : in out Node_Type;
                     Key            : Relationship_Key := Latest_Key;
                     Relation       : Relation_Name := Default_Relation;
                     Mode           : File_Mode := Inout_File;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type := Empty_List;
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is separate;



-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

    procedure Create(File           : in out File_Type;
                     Name           : Name_String;
                     Mode           : File_Mode := Inout_File;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type := Empty_List;
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is
        Base : Node_Type;
    begin
        Open(Base, Base_Path(Name), (1 => Append_Relationships));
        Create(File, Base, Last_Key(Name), Last_Relation(Name), Mode, Form,
            Attributes, Access_Control, Level);
        Close(Base);
    exception
        when others =>
        if Is_Open (File)
        then
        Close (File);
        end if;

            Close(Base);
            raise;

    end Create;


--------------------------------------------------------------------------
--
--    Separate procedure Open
--
--------------------------------------------------------------------------
    procedure Open(File : in out File_Type;
                   Node : Node_Type;
                   Mode : File_Mode) is separate;


-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

    procedure Open(File : in out File_Type;
                   Name : Name_String;
                   Mode : File_Mode) is
        Node : Node_Type;
    begin
        case Mode is
            when In_File =>
                Open(Node, Name, (1 => Read_Contents));
            when Out_File =>
                Open(Node, Name, (1 => Write_Contents));
            when Inout_File =>
                Open(Node, Name, (1 => Read_Contents, 2 => Write_Contents));
            when Append_File =>
                Open(Node, Name, (1 => Append_Contents));
        end case;
        Open(File, Node, Mode);
        Close(Node);
    exception
        when others =>
        if Is_Open (File)
        then
        Close (File);
        end if;

            Close(Node);
            raise;

    end Open;

--------------------------------------------------------------------------
--
--    Separate procedure Close
--
--------------------------------------------------------------------------
    procedure Close(File : in out File_Type) is separate;

--------------------------------------------------------------------------
--
--    Separate procedure Delete
--
--------------------------------------------------------------------------
    procedure Delete(File : in out File_Type) is separate;

----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--
--  Exceptions:
--  ----------
--    Use_Error
--        raised if the node associated with the file identified
--        by File has a value of Terminal or Magnetic_Tape for
--        the attribute File_Kind and the Mode is Append_File.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
---------------------------------------------------------------------

    procedure Reset(File : in out File_Type) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Reset(Get_File_Type(File).all);
    end Reset;

----------------------     Reset     ----------------------
--
--  Purpose:
--  -------
--    Reset the file mode of a CAIS file.
--
--  Parameters:
--  ----------
--    File    An open file handle on the file being reset.
--    Mode    Indicates the mode of the file.
--
--  Exceptions:
--  ----------
--    Use_Error
--        raised if the node associated with the file identified
--        by File has a value of Terminal or Magnetic_Tape for
--        the attribute File_Kind and the Mode is Append_File.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.5 of MIL-STD-CAIS,
--    dated 31 January 1985.
---------------------------------------------------------------------

    procedure Reset(File : in out File_Type;
                    Mode : File_Mode) is separate;

----------------------     Mode     ----------------------
--
--  Purpose:
--  -------
--    Returns the current mode of the current CAIS file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Mode(File : File_Type) return File_Mode is
        Mode : File_Mode;
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Cais.Io_Definitions.Get_Mode(File, Mode);
        return Mode;
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Mode ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Mode ");
            raise Trace.Assertion_Violation;

    end Mode;

----------------------     Name     ----------------------
--
--  Purpose:
--  -------
--    Returns a string containing the name of the CAIS file
--    node currently associated with the file handle.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Name(File : File_Type) return String is
        File_Node_Name : String(1 .. Pragmatics.Max_Name_String);
        Last           : Natural;
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Get_Name(File, File_Node_Name, Last);
        return File_Node_Name(1 .. Last);
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Name ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Name ");
            raise Trace.Assertion_Violation;

    end Name;

----------------------     Form     ----------------------
--
--  Purpose:
--  -------
--    Returns the form string for the external file currently
--    associated with the given file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Form(File : File_Type) return String is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        return Standard.Text_Io.Form(Get_File_Type(File).all);
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Form ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Form ");
            raise Trace.Assertion_Violation;

    end Form;


----------------------     Is_Open     ----------------------
--
--  Purpose:
--  -------
--    Returns TRUE if the file handle is open, otherwise returns FALSE.
--
--  Parameters:
--  ----------
--    File    file handle.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.2.1
--
---------------------------------------------------------------------

    function Is_Open(File : File_Type) return Boolean is
    begin
        return (not Un_Initialized(File)) and then Standard.Text_Io.Is_Open(
            Get_File_Type(File).all);

    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Device_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Is_Open ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Is_Open ");
            raise Trace.Assertion_Violation;

    end Is_Open;



--------------------------------------------------------------------------
--
--    Separate procedure Set_Input
--
--------------------------------------------------------------------------
    procedure Set_Input(File : File_Type) is separate;


--------------------------------------------------------------------------
--
--    Separate procedure Set_Output
--
--------------------------------------------------------------------------
    procedure Set_Output(File : File_Type) is separate;


--------------------------------------------------------------------------
--
--    Separate procedure Set_Error
--
--------------------------------------------------------------------------
    procedure Set_Error(File : File_Type) is separate;


--------------------------------------------------------------------------
--
--    Separate function Standard_Input
--
--------------------------------------------------------------------------
    function Standard_Input return File_Type is separate;



--------------------------------------------------------------------------
--
--    Separate function Standard_Output
--
--------------------------------------------------------------------------
    function Standard_Output return File_Type is separate;


--------------------------------------------------------------------------
--
--    Separate function Standard_Error
--
--------------------------------------------------------------------------
    function Standard_Error return File_Type is separate;


--------------------------------------------------------------------------
--
--    Separate function Current_Input
--
--------------------------------------------------------------------------
    function Current_Input return File_Type is separate;


--------------------------------------------------------------------------
--
--    Separate function Current_Output
--
--------------------------------------------------------------------------
    function Current_Output return File_Type is separate;


--------------------------------------------------------------------------
--
--    Separate function Current_Error
--
--------------------------------------------------------------------------
    function Current_Error return File_Type is separate;


----------------------     Set_Line_Length     ----------------------
--
--  Purpose:
--  -------
--    Sets the maximum line length of the specified output file to the
--    number of characters specified by To.  The value 0 for To specifies an
--    unbounded line length.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    number to which bound is to be set.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--    Use_Error
--        raised if the specified line length is inappropriate for
--        the associated external file.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.3
--
---------------------------------------------------------------------

    procedure Set_Line_Length(File : File_Type;
                              To   : Count) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Set_Line_Length(Get_File_Type(File).all, Standard.
            Text_Io.Count(To));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Mode_Error
            | Cais.Io_Definitions.Device_Error | Cais.Io_Definitions.Use_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Set_Line_Length "
                );
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report(
                "UNANTICIPATED EXCEPTION in Cais.Text_Io.Set_Line_Length ");
            raise Trace.Assertion_Violation;

    end Set_Line_Length;



    procedure Set_Line_Length(To : Count) is
    begin
        Set_Line_Length(Current_Output, To);
    end Set_Line_Length;


----------------------     Set_Page_Length     ----------------------
--
--  Purpose:
--  -------
--    Sets the maximum page length of the specified output file to the
--    number of lines specified by To.  The value 0 for To specifies an
--    unbounded page length.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    number to which bound is to be set.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--    Use_Error
--        raised if the specified page length is inappropriate for
--        the associated external file.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.3
--
---------------------------------------------------------------------

    procedure Set_Page_Length(File : File_Type;
                              To   : Count) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Set_Page_Length(Get_File_Type(File).all, Standard.
            Text_Io.Count(To));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error | Cais.Io_Definitions.Use_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Set_Page_Length "
                );
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report(
                "UNANTICIPATED EXCEPTION in Cais.Text_Io.Set_Page_Length ");
            raise Trace.Assertion_Violation;

    end Set_Page_Length;



    procedure Set_Page_Length(To : Count) is
    begin
        Set_Page_Length(Current_Output, To);
    end Set_Page_Length;



----------------------     Line_Length     ----------------------
--
--  Purpose:
--  -------
--    Returns the line length currently set for the specified output file,
--    or zero if the line length is unbounded.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.3
--
---------------------------------------------------------------------

    function Line_Length(File : File_Type) return Count is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        return Count(Standard.Text_Io.Line_Length(Get_File_Type(File).all));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Line_Length ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Line_Length ")
                ;
            raise Trace.Assertion_Violation;

    end Line_Length;



    function Line_Length return Count is
    begin
        return Line_Length(Current_Output);
    end Line_Length;


----------------------     Page_Length     ----------------------
--
--  Purpose:
--  -------
--    Returns the page length currently set for the specified output file,
--    or zero if the page length is unbounded.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.3
--
---------------------------------------------------------------------

    function Page_Length(File : File_Type) return Count is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        return Count(Standard.Text_Io.Page_Length(Get_File_Type(File).all));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Page_Length ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Page_Length ")
                ;
            raise Trace.Assertion_Violation;

    end Page_Length;



    function Page_Length return Count is
    begin
        return Page_Length(Current_Output);
    end Page_Length;



----------------------     New_Line     ----------------------
--
--  Purpose:
--  -------
--    Outputs a line terminator and sets the current column
--    number to one.  Increments line number or if line
--    number exceeds maximum line for bounded page length,
--    outputs a page terminator, increments page number,
--    and sets line number to one.
--
--  Parameters:
--  ----------
--    File      open file handle.
--    Spacing   number of times New_Line action is performed.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    procedure New_Line(File    : File_Type;
                       Spacing : Positive_Count := 1) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.New_Line(Get_File_Type(File).all, Standard.Text_Io.
            Positive_Count(Spacing));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.New_Line ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.New_Line ");
            raise Trace.Assertion_Violation;

    end New_Line;



    procedure New_Line(Spacing : Positive_Count := 1) is
    begin
        New_Line(Current_Output, Spacing);
    end New_Line;


----------------------     Skip_Line     ----------------------
--
--  Purpose:
--  -------
--    Reads and discards all characters until a line terminator has
--    been read.  Then sets the current column number to one.
--
--  Parameters:
--  ----------
--    File      open file handle.
--    Spacing   number of times Skip_Line action is to be performed.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--    End_Error
--        raised if attempt is made to read a file terminator.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    procedure Skip_Line(File    : File_Type;
                        Spacing : Positive_Count := 1) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Skip_Line(Get_File_Type(File).all, Standard.Text_Io.
            Positive_Count(Spacing));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error | Cais.Io_Definitions.End_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Skip_Line ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Skip_Line ");
            raise Trace.Assertion_Violation;

    end Skip_Line;



    procedure Skip_Line(Spacing : Positive_Count := 1) is
    begin
        Skip_Line(Current_Input, Spacing);
    end Skip_Line;


----------------------     End_Of_Line     ----------------------
--
--  Purpose:
--  -------
--    Returns True if a line terminator or a file terminator
--    is next; otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    function End_Of_Line(File : File_Type) return Boolean is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        return Standard.Text_Io.End_Of_Line(Get_File_Type(File).all);
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.End_of_Line ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.End_of_Line ")
                ;
            raise Trace.Assertion_Violation;

    end End_Of_Line;



    function End_Of_Line return Boolean is
    begin
        return End_Of_Line(Current_Input);
    end End_Of_Line;


----------------------     New_Page     ----------------------
--
--  Purpose:
--  -------
--    Outputs a line terminator if the current line is not
--    terminated or current page is empty.  Outputs a page
--    terminator and adds one to current page number. Sets
--    the current column and line numbers to one.
--
--  Parameters:
--  ----------
--    File      open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    procedure New_Page(File : File_Type) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.New_Page(Get_File_Type(File).all);
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.New_Page ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.New_Page ");
            raise Trace.Assertion_Violation;

    end New_Page;



    procedure New_Page is
    begin
        Cais.Text_Io.New_Page(Current_Input);
    end New_Page;


----------------------     Skip_Page     ----------------------
--
--  Purpose:
--  -------
--    Reads and discards all characters until a page terminator has
--    been read.  Then adds one to the current page number and
--    sets the current column number and line numbers to one.
--
--  Parameters:
--  ----------
--    File      open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--    End_Error
--        raised if attempt is made to read a file terminator.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    procedure Skip_Page(File : File_Type) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Skip_Page(Get_File_Type(File).all);
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error | Cais.Io_Definitions.End_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Skip_Page ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Skip_Page ");
            raise Trace.Assertion_Violation;

    end Skip_Page;



    procedure Skip_Page is
    begin
        Cais.Text_Io.Skip_Page(Current_Input);
    end Skip_Page;


----------------------     End_Of_Page     ----------------------
--
--  Purpose:
--  -------
--    Returns True if a line terminator and a page terminator
--    or a file terminator is next; otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    function End_Of_Page(File : File_Type) return Boolean is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        return Standard.Text_Io.End_Of_Page(Get_File_Type(File).all);
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.End_Of_Page ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.End_Of_Page ")
                ;
            raise Trace.Assertion_Violation;

    end End_Of_Page;



    function End_Of_Page return Boolean is
    begin
        return Cais.Text_Io.End_Of_Page(Current_Input);
    end End_Of_Page;


----------------------     End_Of_File     ----------------------
--
--  Purpose:
--  -------
--    Returns True if a file terminator or the combination of a line
--    terminator, page terminator, and a file terminator
--    is next; otherwise returns False.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Mode_Error
--        raised if mode of the file is not In_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    function End_Of_File(File : File_Type) return Boolean is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        return Standard.Text_Io.End_Of_File(Get_File_Type(File).all);
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.End_Of_File ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.End_Of_File ")
                ;
            raise Trace.Assertion_Violation;

    end End_Of_File;



    function End_Of_File return Boolean is
    begin
        return Cais.Text_Io.End_Of_File(Current_Input);
    end End_Of_File;



----------------------     Set_Col     ----------------------
--
--  Purpose:
--  -------
--    If mode is Out_File, outputs spaces until current column
--    equals To.  If To is less than current column, a New_Line
--    is performed first.
--
--    If mode is In_File, discards characters until next character
--    has column equal to To.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    column number.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Layout_Error
--        raised if mode is Out_File and To exceeds maximum
--        line length.
--    End_Error
--        raised if attempt is made to read file terminator.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    procedure Set_Col(File : File_Type;
                      To   : Positive_Count) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Set_Col(Get_File_Type(File).all, Standard.Text_Io.Count
            (To));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Layout_Error | Cais.Io_Definitions.End_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Set_Col ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Set_Col ");
            raise Trace.Assertion_Violation;

    end Set_Col;



    procedure Set_Col(To : Positive_Count) is
    begin
        Set_Col(Current_Output, To);
    end Set_Col;



----------------------     Set_Line     ----------------------
--
--  Purpose:
--  -------
--    If mode is Out_File, performs New_Line until current line
--    equals To.  If To is less than current line, a New_Page
--    is performed first.
--
--    If mode is In_File, performs Skip_Line until current line number
--    is equal to To.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    To    column number.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle is not open.
--    Layout_Error
--        raised if mode is Out_File and To exceeds maximum
--        page length.
--    End_Error
--        raised if attempt is made to read file terminator.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    procedure Set_Line(File : File_Type;
                       To   : Positive_Count) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Set_Line(Get_File_Type(File).all, Standard.Text_Io.
            Positive_Count(To));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Layout_Error | Cais.Io_Definitions.End_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Set_Line ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Set_Line ");
            raise Trace.Assertion_Violation;

    end Set_Line;



    procedure Set_Line(To : Positive_Count) is
    begin
        Set_Line(Current_Output, To);
    end Set_Line;


----------------------     Col     ----------------------
--
--  Purpose:
--  -------
--    Returns the current column number.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Layout_Error
--        raised if this number exceeds Count'Last.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    function Col(File : File_Type) return Positive_Count is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        return Positive_Count(Standard.Text_Io.Col(Get_File_Type(File).all));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Layout_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Col ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Col ");
            raise Trace.Assertion_Violation;

    end Col;



    function Col return Positive_Count is
    begin
        return Col(Current_Output);
    end Col;


----------------------     Line     ----------------------
--
--  Purpose:
--  -------
--    Returns the current line number.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Layout_Error
--        raised if this number exceeds Count'Last.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    function Line(File : File_Type) return Positive_Count is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        return Positive_Count(Standard.Text_Io.Line(Get_File_Type(File).all));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Layout_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Line ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Line ");
            raise Trace.Assertion_Violation;

    end Line;



    function Line return Positive_Count is
    begin
        return Line(Current_Output);
    end Line;


----------------------     Page     ----------------------
--
--  Purpose:
--  -------
--    Returns the current page number.
--
--  Parameters:
--  ----------
--    File    open file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file is not open.
--    Layout_Error
--        raised if this number exceeds Count'Last.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.4
--
---------------------------------------------------------------------

    function Page(File : File_Type) return Positive_Count is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        return Positive_Count(Standard.Text_Io.Page(Get_File_Type(File).all));
    exception
    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Layout_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Page ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Page ");
            raise Trace.Assertion_Violation;

    end Page;



    function Page return Positive_Count is
    begin
        return Page(Current_Output);
    end Page;



----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file into the item parameter.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of type Character.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Get(File : File_Type;
                  Item : in out Character) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Get(Get_File_Type(File).all, Item);
    exception

    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error | Cais.Io_Definitions.End_Error |
            Cais.Io_Definitions.Data_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Get ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Get ");
            raise Trace.Assertion_Violation;

    end Get;


    procedure Get(Item : in out Character) is
    begin
        Get(Current_Input, Item);
    end Get;

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified file.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of type Character.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Put(File : File_Type;
                  Item : Character) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Put(Get_File_Type(File).all, Item);
    exception

    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error | Cais.Io_Definitions.Layout_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Put ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Put ");
            raise Trace.Assertion_Violation;

    end Put;


    procedure Put(Item : Character) is
    begin
        Put(Current_Output, Item);
    end Put;

----------------------     Get     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads characters from the specified
--    text file into the item parameter.
--    The number of Get character operations is determined by
--    the length of the string.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of type String.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Get(File : File_Type;
                  Item : in out String) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Get(Get_File_Type(File).all, Item);

    exception

    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error | Cais.Io_Definitions.End_Error |
            Cais.Io_Definitions.Data_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Get ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Get ");
            raise Trace.Assertion_Violation;

    end Get;


    procedure Get(Item : in out String) is
    begin
        Get(Current_Input, Item);
    end Get;

----------------------     Put     ----------------------
--
--  Purpose:
--  -------
--    This procedure writes characters to the specified file.
--    The number of Put character operations is determined by
--    the length of the string.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of type String.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--    Layout_Error
--        raised if the number of characters to be output
--        exceeds the maximum line length.
--
--  Notes:
--  -----
--    This procedure is defined in section 5.3.4.6 of MIL-STD-CAIS,
--    dated 31 January 1985.
--
---------------------------------------------------------------------

    procedure Put(File : File_Type;
                  Item : String) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Put(Get_File_Type(File).all, Item);

    exception

    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error | Cais.Io_Definitions.Layout_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Put ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Put ");
            raise Trace.Assertion_Violation;

    end Put;


    procedure Put(Item : String) is
    begin
        Put(Current_Output, Item);
    end Put;

----------------------     Get_Line     ----------------------
--
--  Purpose:
--  -------
--    This procedure reads successive characters from the specified
--    text file into the item parameter.  Reading stops if the end
--    of line is met.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    out parameter of type String.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not In_File.
--    End_Error
--        raised if attempt is made to skip file terminator.
--    Data_Error
--        raised if the sequence input is not a lexical element
--        corresponding to the item type.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.6.
--
---------------------------------------------------------------------

    procedure Get_Line(File : File_Type;
                       Item : in out String;
                       Last : in out Natural) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Get_Line(Get_File_Type(File).all, Item, Last);

    exception

    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error | Cais.Io_Definitions.End_Error |
            Cais.Io_Definitions.Data_Error =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Get_Line ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Get_Line ");
            raise Trace.Assertion_Violation;

    end Get_Line;


    procedure Get_Line(Item : in out String;
                       Last : in out Natural) is
    begin
        Get_Line(Current_Input, Item, Last);
    end Get_Line;

----------------------     Put_Line     ----------------------
--
--  Purpose:
--  -------
--    This procedure calls procedure Put for the given string,
--    then New_Line, with a spacing of one.
--
--  Parameters:
--  ----------
--    File    open file handle.
--    Item    in parameter of type String.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if File is not open.
--    Mode_Error
--        raised if file mode is not Out_File or Append_File.
--
--  Notes:
--  -----
--    Semantics correspond to Ada LRM, Section 14.3.6
--
---------------------------------------------------------------------

    procedure Put_Line(File : File_Type;
                       Item : String) is
    begin
        Check_Open(File, True);   -- Status_Error if File is not open
        Standard.Text_Io.Put_Line(Get_File_Type(File).all, Item);
    exception

    -- exceptions that are propagated
        when Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Device_Error
            | Cais.Io_Definitions.Mode_Error | Cais.Io_Definitions.Layout_Error
            =>
            raise;

    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Cais.Text_Io.Put_Line ");
            raise;

    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Cais.Text_Io.Put_Line ");
            raise Trace.Assertion_Violation;

    end Put_Line;


    procedure Put_Line(Item : String) is
    begin
        Put_Line(Current_Output, Item);
    end Put_Line;

--------------------------------------------------------------------------
--
--    Separate generic package bodies
--        Integer_Io
--        Enumeration_Io
--        Fixed_Io
--        Float_Io
--
--------------------------------------------------------------------------

-- generic package for Input-Output of Integer Types

    package body Integer_Io is separate;

-- generic package for Input-Output of Floating Point Types

    package body Float_Io is separate;

-- generic package for Input-Output of Fixed Point Types

    package body Fixed_Io is separate;

-- generic package for Input-Output of Enumeration Types

    package body Enumeration_Io is separate;

-----------------------------------------------------------------------------
end Text_Io;
-----------------------------------------------------------------------------
--::::::::::::::
--cais_utilities_body.a
--::::::::::::::

----------------------------------------------------------------------
--                   C A I S _ U T I L I T I E S
--                          (Package Body)
--
--
--               A Collection of Miscellaneous Utility Routines
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Mon Jul  8 21:21:18 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

----------------------------------------------------------------------
--                   C A I S _ U T I L I T I E S
--
--  Purpose:
--  -------
--    This package serves to collect together various simple utilities
--    used in the CAIS prototype.  None of the utilities use "internals"
--    knowledge, i.e. all the interfaces that are used by these routines
--    are either in the externally visible MIL-STD-CAIS specification or
--    are in standard libraries.
--
--  Usage:
--  -----
--    TBS
--
--  Example:
--  -------
--    The procedure String_To_Simple_List and Simple_List_To_String
--    are useful for avoiding the error-prone manipulation of String
--    Items in List_Utilities (and working with the leading and trailing
--    embedded "s).
--
--  Notes:
--  -----
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------
with Character_Set; use Character_Set;
with Sequential_Io;

separate(Cais)
package body Cais_Utilities is

    use Trace;
    use Pragmatics;
    use Node_Management;


    procedure String_To_Simple_List(Str  : String;
                                    List : in out List_Type) is

        Offset   : Integer;
        Tmp_List : List_Type;
    begin
        Offset := Last_Non_Space(Str);
        Copy(List, Empty_List);
        Copy(Tmp_List, Empty_List);
        String_Items.Insert(List => Tmp_List, List_Item => Str(Str'First ..
            Offset), Position => 0);
        Insert(List => List, List_Item => Tmp_List, Position => 0);
    end String_To_Simple_List;

    procedure Simple_List_To_String(List : List_Type;
                                    Str  : in out String) is

        Tmp_List   : List_Type;
        Tmp_String : String(1 .. Str'Length);
        Len        : Natural;
    begin
        Str(Str'range ) := (others => ' ');
        Extract(List => List, Position => 1, List_Item => Tmp_List);
        Len := Text_Length(Tmp_List, 1);
        Tmp_String(1 .. Len) := String_Items.Extract(List => Tmp_List, Position
            => 1);
        Str(Str'First .. Str'First + Len - 1) := Tmp_String(1 .. Len);

    end Simple_List_To_String;


----------------------  C H E C K _ I N T E N T I O N S ------------------
--
--  Purpose:
--  -------
--    This procedure checks that a Node has been opened with an
--    intent that explicitly or implicitly grants the priveledges of
--    Intent specified as a parameter.
--
--  Parameters:
--  ----------
--    Node      is the Node to be accessed
--    Intent    is the stated intention for accessing the node
--
--  Exceptions:
--  ----------
--    Node_Definitions.INTENT_VIOLATION  - if the specified intent
--        is not explicitly or implicitly granted by the current
--        Intention of the Node
--    Node_Definitions.USE_ERROR        - if Node is not an open node handle
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
    procedure Check_Intentions(Node     : in Node_Type;
                               Intended : in Intent_Specification) is

        Intent : Intention(Node_Management.Intent_Of(Node)'range );
    begin
        Intent := Node_Management.Intent_Of(Node);
        Check_Intentions(Intent, Intended);
    end Check_Intentions;

----------------------  C H E C K _ I N T E N T I O N S ------------------
--
--  Purpose:
--  -------
--    This procedure checks that a Node has been opened with an
--    intent that explicitly or implicitly grants the priveledges of
--    Intent specified as a parameter.
--
--  Parameters:
--  ----------
--    Node      is the Node to be accessed
--    Intent    is the stated intention for accessing the node
--
--  Exceptions:
--  ----------
--    Node_Definitions.INTENT_VIOLATION  - if the specified intent
--        is not explicitly or implicitly granted by the current
--        Intention of the Node
--    Node_Definitions.USE_ERROR        - if Node is not an open node handle
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
    procedure Check_Intentions(Intent   : in Intention;
                               Intended : in Intent_Specification) is


    begin
        for I in Intent'range loop
            if Intent(I) = Intended then
                return;         --Intent is valid
            end if;
            case Intended is            --Check for implicit matches
                when Existence =>
                    null;
                when Read =>
                    if Intent(I) = Exclusive_Read_Relationships then
                        return; --Intent is valid
                    end if;
                when Exclusive_Read =>
                    null;
                when Write =>
                    if Intent(I) = Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Exclusive_Write =>
                    null;
                when Read_Contents =>
                    if Intent(I) = Exclusive_Read_Contents or Intent(I) = Read
                        or Intent(I) = Exclusive_Read then
                        return; --Intent is valid
                    end if;
                when Exclusive_Read_Contents =>
                    if Intent(I) = Exclusive_Read then
                        return; --Intent is valid
                    end if;
                when Write_Contents =>
                    if Intent(I) = Exclusive_Write_Contents or Intent(I) = Write
                        or Intent(I) = Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Exclusive_Write_Contents =>
                    if Intent(I) = Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Append_Contents =>
                    if Intent(I) = Exclusive_Append_Contents or Intent(I) =
                        Write_Contents or Intent(I) = Exclusive_Write_Contents
                        or Intent(I) = Write or Intent(I) = Exclusive_Write
                        then
                        return; --Intent is valid
                    end if;
                when Exclusive_Append_Contents =>
                    if Intent(I) = Exclusive_Write_Contents or Intent(I) =
                        Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Read_Attributes =>
                    if Intent(I) = Exclusive_Read_Attributes or Intent(I) = Read
                        or Intent(I) = Exclusive_Read then
                        return; --Intent is valid
                    end if;
                when Exclusive_Read_Attributes =>
                    if Intent(I) = Exclusive_Read then
                        return; --Intent is valid
                    end if;
                when Write_Attributes =>
                    if Intent(I) = Exclusive_Write_Attributes or Intent(I) =
                        Write or Intent(I) = Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Exclusive_Write_Attributes =>
                    if Intent(I) = Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Append_Attributes =>
                    if Intent(I) = Exclusive_Append_Attributes or Intent(I) =
                        Write_Attributes or Intent(I) =
                        Exclusive_Write_Attributes or Intent(I) = Write or
                        Intent(I) = Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Exclusive_Append_Attributes =>
                    if Intent(I) = Exclusive_Write_Attributes or Intent(I) =
                        Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Read_Relationships =>
                    if Intent(I) = Exclusive_Read_Relationships or Intent(I) =
                        Read or Intent(I) = Exclusive_Read then
                        return; --Intent is valid
                    end if;
                when Exclusive_Read_Relationships =>
                    if Intent(I) = Exclusive_Read then
                        return; --Intent is valid
                    end if;
                when Write_Relationships =>
                    if Intent(I) = Exclusive_Write_Relationships or Intent(I) =
                        Write or Intent(I) = Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Exclusive_Write_Relationships =>
                    if Intent(I) = Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Append_Relationships =>
                    if Intent(I) = Exclusive_Append_Relationships or Intent(I)
                        = Write_Relationships or Intent(I) =
                        Exclusive_Write_Relationships or Intent(I) = Write or
                        Intent(I) = Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Exclusive_Append_Relationships =>
                    if Intent(I) = Exclusive_Write_Relationships or Intent(I) =
                        Exclusive_Write then
                        return; --Intent is valid
                    end if;
                when Control =>
                    if Intent(I) = Exclusive_Control then
                        return; --Intent is valid
                    end if;
                when Exclusive_Control =>
                    null;
                when Execute =>
                    null;
            end case;   --  Case Intended is

        end loop;       -- for I in Intent'range loop

        -- if we get here, there has not been an explicit or implicit
        -- match for the entire Intention array of the node.
        raise Node_Definitions.Intent_Violation;

    end Check_Intentions;


----------------------  C H E C K _ I N T E N T I O N S ------------------
--
--  Purpose:
--  -------
--    This procedure checks that the first parameter is an
--    Intent that explicitly or implicitly grants the privileges of
--    Intended specified as the second parameter.
--
--  Parameters:
--  ----------
--    Intent    is the Intent allowable
--    Intended  is the stated Intention array for accessing the node
--
--  Exceptions:
--  ----------
--    Node_Definitions.INTENT_VIOLATION  - if the specified intention
--        is not explicitly or implicitly granted by the allowable
--        Intention
--
--  Notes:
--  -----
--    This procedure overloads the procedure which checks a single
--    intent specification.
--
---------------------------------------------------------------------------


    procedure Check_Intentions(Intent   : in Intention;
                               Intended : in Intention) is

    begin
        for I in Intended'range loop
            Check_Intentions(Intent, Intended(I));
        end loop;
        return;         --Intended is valid

    end Check_Intentions;


----------------------   Predefined   ------------------------------
--
--  Purpose: This function checks that an attribute defined by the user
--  -------  is not identical to one of the predefined CAIS attributes
--
--  Parameters:
--  ----------
--    Name      is the attribute being defined by the user
--
--  Exceptions:
--  ----------
--   None
--
--  Notes:
--  -----
--   Uses the CAIS package body variables Predefined_Attributes and
--   Predefined_Relations
---------------------------------------------------------------------------
    function Predefined(Name : String;
                        Kind : Predefined_Kind) return Boolean is
        Pos : Position_Count;   --unused value needed for Position_By_Name
    begin
        case Kind is
            when Attribute =>
                Pos := Position_By_Name(Cais.Predefined_Attributes, Name);
                return True;    --will only be executed if Name is found
                                --in Predefined_Attributes, otherwise the
                                --exception Search_Error is raised.  See below.
            when Relation =>
                Pos := Position_By_Name(Cais.Predefined_Relations, Name);
                return True;    --will only be executed if Name is found
                                --in Predefined_Attributes, otherwise the
                                --exception Search_Error is raised.  See below.
        end case;

    exception
        -- exceptions that are trapped (nothing propogated)
        when Search_Error =>
            return False;       --All is right, Name was not predefined

        -- exceptions that are propogated
            -- NONE

        -- exceptions that are mapped to other exceptions
            -- NONE

        -- predefined exceptions (propogated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in " &
                "Cais_Utilities.Predefined");
            raise;

        -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in " &
                "Cais_Utilities.Predefined");
            raise Trace.Assertion_Violation;

    end Predefined;

----------------------      Copy      ----------------------
--
--  Purpose:
--  -------
--    This procedure copies to host (Ada) files byte by byte.
--
--  Parameters:
--  ----------
--    From_File    string identifying the file to be copied
--    To_File     string identifying the file to be written
--
--  Exceptions:
--  ----------
--    I/O errors other than End_Error are propogated.
--  Notes:
--  -----
--    Uses Sequential_Io.
--
---------------------------------------------------------------------

    procedure Copy(From_File : in String;
                   To_File   : in String)

    is
        package Byte_Io is
            new Standard.Sequential_Io(Tiny_Integer);

        Length  : Natural;
        From_Io : Byte_Io.File_Type;
        To_Io   : Byte_Io.File_Type;
        Byte    : Tiny_Integer;

    begin
        Byte_Io.Open(From_Io, Byte_Io.In_File, From_File);
        Byte_Io.Open(To_Io, Byte_Io.Out_File, To_File);

        begin
            loop
                Byte_Io.Read(From_Io, Byte);
                Byte_Io.Write(To_Io, Byte);
            end loop;
        exception
            when Byte_Io.End_Error =>
                Byte_Io.Close(From_Io);
                Byte_Io.Close(To_Io);
        end;
    exception
        -- exceptions that are trapped (nothing propagated)
        --    End_Error
        -- exceptions that are propagated

        -- all other exceptions (propagated with trace)
        when others =>
            Trace.Report("UNEXPECTED EXCEPTION in File_To_File Copy");
            raise;
    end Copy;


function Valid_Relation_Name (Name : String) return Boolean is
    Dummy_Token : List_Utilities.Token_Type;
    Last_Char   : Natural;
begin
    Last_Char := Character_Set.Last_Non_Space (Name);
    if Last_Char = 0 then -- blank string...
    return False;
    end if;

    List_Utilities.Identifier_Items.To_Token (
    Identifier => Name (1 .. Last_Char),
    Token => Dummy_Token);
    -- If we get here, it is clearly ok
    return True;
exception
    when Node_Definitions.Use_Error => -- see if it's a "."
    if Name'Last > 0 and then
        Last_Char = 1 and then
        Name (1) = '.' then
        return True;
    else
        return False;
    end if;
    when others =>
    Trace.Report ("Valid_Relation Name raised unexpected exception");
    raise Trace.Assertion_Violation;
end Valid_Relation_Name;


function Valid_Relation_Key (Name : String) return Boolean is
    Dummy_Token : List_Utilities.Token_Type;
    Last_Char   : Natural;

begin

    Last_Char := Character_Set.Last_Non_Space (Name);
    if Last_Char = 0 then -- blank string...
    return True;
    end if;

    if Name (Last_Char) = '#' then
    if Last_Char = 1 then
        return True;
    else
        List_Utilities.Identifier_Items.To_Token (
        Identifier => Name (1 .. Last_Char -1),
        Token => Dummy_Token);
    end if;
    else
    List_Utilities.Identifier_Items.To_Token (
        Identifier => Name (1 .. Last_Char),
        Token => Dummy_Token);
    -- If we get here, it is clearly ok
    end if;
    return True;
exception
    when Node_Definitions.Use_Error =>
    return False;
    when others =>
    Trace.Report ("Valid_Relation_Key raised unexpected exception");
    raise Trace.Assertion_Violation;
end Valid_Relation_Key;
end Cais_Utilities;
--::::::::::::::
--copy_node.a
--::::::::::::::



----------------------------------------------------------------------
--                       C O P Y _ N O D E
--           (Separate procedure in Node_Management)
--
--
--  Copies one node (without relationships) to a newly created node
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Wed Jun 26 09:10:14 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

--------------------       C O P Y _ N O D E       -------------------
--
--  Purpose:
--  -------
--    These procedures copy a file or structural node THAT DOES NOT HAVE
--    EMANATING PRIMARY RELATIONSHIPS.  The node copied is identified by
--    the open node handle "From" and is copied to a newly created node.
--    The new node is identified by the combination of the To_Base, To_Key,
--    and To_Relation parameters.  The newly created node is of the same
--    kind as the node identified by From. If the node is a file node, its
--    contents are also copied, i.e., a new copied file is created.  Any
--    secondary relationships emanating from the original node, excepting
--    the relation of the predefined relation parent(which is appropriately
--    adjusted), are recreated in the copy.  If the target of the original
--    nodes relationship IS THE NODE ITSELF, THEN THE COPY HAS AN ANALOGOUS
--    RELATION TO ITSELF.  Any other secondary relationship whose target is
--    the original node is unaffected.  All attributes of the From node are
--    also copied.  Regardless of any locks on the node identified by From,
--    the newly creasted node is unlucked.
--
--  Parameters:
--  ----------
--    From      - an open node handle to the node to be copied.
--    To_Base   - open node handle to a base node for identification of the
--          node to be created.
--    To_Key    - the relationship key for identification of the node to be
--              - created.
--    To_Relation  - the relation name for identification of the node to be
--                created.
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the new node identification is illegal
--                        or if a node already exists with the identification
--                        given for the new node.
--    Use_Error         - is raised if the origianl node is not a file or
--              structural node or if any primary relationships
--              emanate from the original node.  Use_Error is also
--              raised if the To_Relation is the name of a predefined
--              relation that cannot be modified or created by the
--              user.
--    Status_Error      - is raised if the Node_Handles From and To_Base are
--              not both open.
--    Intent_Violation  - is raised if "From" was not opened with an intent
--                        establishing the right to read contents, attributes
--              and relationships, or if To_Base was not opened with
--              the right to append relationships. Intent_Violation
--              is not raised if the conditions for name error are
--              present.
--    Security_Violation -is raised if the attempt to obtain access to the
--                        node with the specified intent represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.18
--  -----
--
---------------------------------------------------------------------
separate(Cais.Node_Management)
procedure Copy_Node(From        : Node_Type;
                    To_Base     : in out Node_Type;
                    To_Key      : Relationship_Key;
                    To_Relation : Relation_Name := Default_Relation) is
    use Identifier_Items;

    New_Node      : Node_Type;

    Access_List   : List_Type;
    Level         : List_Type;
    Attr          : List_Type;
    Rel_Att       : List_Type;
    Relations     : List_Type;
    Relationships : List_Type;

    Parent_Token  : Token_Type;
    Syntax_Check  : Token_Type;
    Rel           : Token_Type;
    Key           : Token_Type;

    Shadow_File   : String(1 .. Max_Shadow_File_Length);
    Self          : String(1 .. Max_Shadow_File_Length);
    New_Self      : String(1 .. Max_Shadow_File_Length);
    Old_Contents  : String(1 .. Max_Shadow_File_Length);
    New_Contents  : String(1 .. Max_Shadow_File_Length);
    Size1         : Integer range 1 .. Max_Shadow_File_Length := 1;
    Size2         : Integer range 1 .. Max_Shadow_File_Length := 1;
    Kind          : Node_Kind;
    Primary       : Boolean := True;

begin
    if not Is_Open(From) then                           --From and Base must be
        raise Node_Definitions.Status_Error;            --open. Create checks
    end if;                                             --Base.



    -- Make sure that Name_Error conditions don't exist for the target.
    -- Note Create also checks for existence of the relationship.  This
    -- check is made here so that the Intent of the From node
    -- may be checked in the order required by MIL-STD-CAIS
    Check_Name : begin
      --First Check for syntax errors in the Relation and Key parameter
      --To_Token raises Use_Error for improper syntax
        To_Token(To_Relation, Syntax_Check);
        To_Token(To_Key, Syntax_Check);

      --Now Make sure the relationship doesn't exist.
        Node_Representation.Get_A_Relationship(Node => To_Base, Rel_Name =>
            To_Relation, Rel_Key => To_Key, Rel_Attributes => Rel_Att, Primary
            => Primary, Shadow_File => Shadow_File);
        -- if we get here, the specified relationship already exists.
        -- This procedure call is history...
        raise Node_Definitions.Name_Error;
    exception
        when Node_Definitions.Use_Error =>
            raise Node_Definitions.Name_Error;
        when No_Such_Relation | No_Such_Relationship =>
            null;  -- the relationship does NOT exist...
    end Check_Name;


                        --Check File Kind. Create same kind of node or
                        --raise Use_Error for process nodes. Create checks
                        --that To_Relation is not predefined
    Kind := Get_Kind(From);
    if Kind = Structural or else Kind = File then

        Cais_Utilities.Check_Intentions(From, Read);    --Insure proper intent
        Cais_Utilities.Check_Intentions(To_Base, Append_Relationships);


        Get_Node_Relations(From, Relations);            --Check for Primary
                                                        --Relationships on
                                                        --each relation
        for I in 1 .. Length(Relations) loop
            Item_Name(Relations, I, Rel);
            Extract(Relations, I, Relationships);

            for J in 1 .. Length(Relationships) loop
                Item_Name(Relationships, J, Key);
                Get_A_Relationship(From, To_Text(Rel), To_Text(Key), Shadow_File
                    , Rel_Att, Primary);
                if Primary then --Error: Primary Relationship not allowed
                    raise Node_Definitions.Use_Error;
                end if;
            end loop;
        end loop;


                        --Obtain old Node information to be copied
        Get_Node_Access_Control(From, Access_List);
        Get_Node_Level(From, Level);
        Get_Node_Attributes(From, Attr);

        Create_Node(New_Node, To_Base, Kind, Attr, Empty_List, Empty_List, (1
            => Exclusive_Write, 2 => Read_Relationships), Access_List, Level,
            To_Key, To_Relation);
    else
        raise Node_Definitions.Use_Error;
    end if;

    Get_Shadow_File_Name(From, Self, Size1);
    Get_Shadow_File_Name(New_Node, New_Self, Size1);

                                --Now update relationships, making appropriate
                                --changes to self-references and ignoring the
                                --parent relationship
    To_Token("PARENT", Parent_Token);
    Get_Node_Relations(From, Relations);
                                --for each relation
    for I in 1 .. Length(Relations) loop
        Item_Name(Relations, I, Rel);
        Extract(Relations, I, Relationships);

        if not Is_Equal(Rel, Parent_Token) then         --for each relationship
            for J in 1 .. Length(Relationships) loop
                Item_Name(Relationships, J, Key);
                Get_A_Relationship(From, To_Text(Rel), To_Text(Key), Shadow_File
                    , Rel_Att, Primary);
                                --copy 2ndary rel looking for self-references
                if Shadow_File = Self then
                    Set_A_Relationship(New_Node, To_Text(Rel), To_Text(Key),
                        Rel_Att, Primary, New_Self);
                else
                    Set_A_Relationship(New_Node, To_Text(Rel), To_Text(Key),
                        Rel_Att, Primary, Shadow_File);
                end if;
            end loop;
        end if;
    end loop;

                        --If this is a File_Node, copy the Contents_File
    if Kind = File then
        Get_Contents_File_Name(From, Old_Contents, Size1);

        Cais_Host_Dependent.Get_Unique_Filename(New_Contents, Size2);
        Set_Contents_File_Name(New_Node, New_Contents(1 .. Size2));
        Cais_Utilities.Copy(Old_Contents(1 .. Size1), New_Contents(1 .. Size2))
            ;
    end if;

    Write_Shadow_File(New_Node);

end Copy_Node;
--::::::::::::::
--copy_tree.a
--::::::::::::::


----------------------------------------------------------------------
--                       C O P Y _ T R E E
--           (Separate procedure in Node_Management)
--
--
--  Copies the primary relationships (+ associated nodes) of one node to another
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Wed Jun 26 09:10:14 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

------------------       C O P Y _ T R E E       ------------------------
--
--  Purpose:
--  -------
--    These procedures copy a tree of file or structural nodes formed by the
--    primary relationships emanating from the node identified by the open node
--    handle From.  Primary relationships are recreated between corresponding
--    copied nodes.  The root node of the newly created tree corresponding to
--    the From node is the node identified by the combination of the To_Base,
--    To_Key, and To_Relation parameters.  If an exception is raised by the
--    procedure none of the nodes are copied.  Secondary relationships,
--    attributes, and node contents are copied as described for Copy_Node with
--    the following additional rules: secondary relationships between two nodes
--    which are both copied are recreated between the two copies.  Secondary
--    relationships emanating from a node which is copied, but which refer to
--    nodes outside the tree being copied, are copied so that they emanate from
--    the copy, but still refer to the original target node.  Secondary
--    relationships emanating from a node which is not copied, but which refer
--    to nodes inside the tree being copied, are unaffected.  If the node
--    identified by To_Base is part of the tree being copied, then the copy of
--    the node identified by From will not be copied recursively.
--
--  Parameters:
--  ----------
--    From      - an open node handle to the root node of the tree to be copied.
--    To_Base   - open node handle to a base node for identification of the
--          node to be created as root of the new tree.
--    To_Key    - the relationship key for identification of the node to be
--              - created as root of the new tree.
--    To_Relation  - the relation name for identification of the node to be
--                created as root of the new tree.
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the new node identification is illegal
--                        or if a node already exists with the identification
--                        given for the new node to be created as a copy of
--              the node identified by From.
--    Use_Error         - is raised if the origianl node is not a file or
--              structural node.  Use_Error is also raised if the
--              To_Relation is the name of a predefined relation
--              that cannot be modified or created by the user.
--    Status_Error      - is raised if the Node_Handles From and To_Base are
--              not both open.
--    Lock_Error    - is raised if any node to be copied except the node
--              identified by From is locked against read access to
--              attributes, relationships, or contents.
--    Intent_Violation  - is raised if "From" was not opened with an intent
--                        establishing the right to read contents, attributes
--              and relationships, or if To_Base was not opened with
--              the right to append relationships. Intent_Violation
--              is not raised if the conditions for name error are
--              present.
--    Access_Violation     - is raised if the current process' discretionary
--              access control rights are insufficient to obtain
--              access to each node to be copied with intent Read.
--              Access_Violation is not raised if conditions for
--              Name_Error are present.
--    Security_Violation -is raised if the operations represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.19
--  -----
--
---------------------------------------------------------------------
separate(Cais.Node_Management)
procedure Copy_Tree(From        : Node_Type;
                    To_Base     : in out Node_Type;
                    To_Key      : Relationship_Key;
                    To_Relation : Relation_Name := Default_Relation) is

    use Identifier_Items;

    Old_Shadow_File : String(1 .. Max_Shadow_File_Length);
    New_Shadow_File : String(1 .. Max_Shadow_File_Length);
    Shadow_File     : String(1 .. Max_Shadow_File_Length);
    Syntax_Check    : Token_Type;
    Rel_Attr        : List_Type;
    Primary         : Boolean := True;
    Size            : Natural range 1 .. Max_Shadow_File_Length := 1;
    New_Node        : Node_Type;
    Kind            : Node_Kind;

    package Shadows is
        procedure Save_Shadows(New_Shadow : String;
                               Old_Shadow : String);
        function Check_Shadow(Shadow : String) return String;
    end Shadows;

    package body Shadows is
        type Shadow_Pair;
        type Shadow_List is access Shadow_Pair;
        type Shadow_Pair is
            record
                New_Shadow  : String(1 .. Max_Shadow_File_Length);
                Old_Shadow  : String(1 .. Max_Shadow_File_Length);
                Next_Shadow : Shadow_List;
            end record;
        Shadows : Shadow_List;

        procedure Save_Shadows(New_Shadow : String;
                               Old_Shadow : String) is
            New_Record : Shadow_List := new Shadow_Pair'(New_Shadow, Old_Shadow
                , Shadows);
        begin
            Shadows := New_Record;
        end Save_Shadows;

        function Check_Shadow(Shadow : String) return String is
            Cursor : Shadow_List := Shadows;
        begin
            while Cursor /= null loop
                if Shadow = Cursor.Old_Shadow then
                    return Cursor.New_Shadow;
                end if;
                Cursor := Cursor.Next_Shadow;
            end loop;
            return Shadow;
        end Check_Shadow;
    end Shadows;
    use Shadows;

    procedure Copy_Any_Node(From        : Node_Type;
                            To_Base     : in out Node_Type;
                            To_Key      : Relationship_Key;
                            To_Relation : Relation_Name;
                            New_Node    : in out Node_Type) is
        Kind        : Node_Kind;
        Access_List : List_Type;
        Level       : List_Type;
        Attr        : List_Type;
        Relations   : List_Type;
    begin
        Kind := Get_Kind(From);
        Get_Node_Access_Control(From, Access_List);
        Get_Node_Level(From, Level);
        Get_Node_Attributes(From, Attr);

        Create_Node(New_Node, To_Base, Kind, Attr, Empty_List, Empty_List, (1
            => Read, 2 => Exclusive_Write), Access_List, Level, To_Key,
            To_Relation);
    end Copy_Any_Node;


    procedure Mark_Tree(Node : Node_Type) is
        Node_To_Copy  : Node_Type;
        Relation_List : List_Type;
        Key_List      : List_Type;
        Rel_Name      : Token_Type;
        Key_Name      : Token_Type;
        Rel_Attr      : List_Type;
        Primary       : Boolean := True;
        Shadow_File   : String(1 .. Max_Shadow_File_Length);
    begin
        Get_Node_Relations(Node, Relation_List);
        for I in 1 .. Length(Relation_List) loop
            Item_Name(Relation_List, I, Rel_Name);
            Extract(Relation_List, I, Key_List);
            for J in 1 .. Length(Key_List) loop
                Item_Name(Key_List, J, Key_Name);
                Get_A_Relationship(Node, To_Text(Rel_Name), To_Text(Key_Name),
                    Shadow_File, Rel_Attr, Primary);
                if Primary then
                    --!TBD Mark_Access(Shadow_File, Read);

                    Set_Shadow_File_Name(Node_To_Copy, Shadow_File);
                    Read_Shadow_File(Node_To_Copy);
                    Mark_Tree(Node_To_Copy);            --Recursive Call!!
                end if;
            end loop;       --check all keys
        end loop;               --check all relations
    end Mark_Tree;
    procedure Copy_Sub_Tree(From              : Node_Type;
                            To_Base           : in out Node_Type;
                            To_Key            : Relationship_Key;
                            To_Relation       : Relation_Name;
                            Node_Just_Created : in out Node_Type) is
        New_Node_Copied  : Node_Type;
        Old_Node_To_Copy : Node_Type;
        Relation_List    : List_Type;
        Key_List         : List_Type;
        Rel_Name         : Token_Type;
        Key_Name         : Token_Type;
        Rel_Attr         : List_Type;
        Primary          : Boolean := True;
        Old_Shadow_File  : String(1 .. Max_Shadow_File_Length);
        New_Shadow_File  : String(1 .. Max_Shadow_File_Length);
        New_Contents     : String(1 .. Max_Shadow_File_Length);
        Old_Contents     : String(1 .. Max_Shadow_File_Length);
        Size             : Natural range 1 .. Max_Shadow_File_Length := 1;
        Size1            : Natural range 1 .. Max_Shadow_File_Length := 1;
        Size2            : Natural range 1 .. Max_Shadow_File_Length := 1;
    begin
        Copy_Any_Node(From, To_Base, To_Key, To_Relation, Node_Just_Created);
                        --If this is a File_Node, copy the Contents_File
        if Get_Kind(From) = File then
            Get_Contents_File_Name(From, Old_Contents, Size1);
            Cais_Host_Dependent.Get_Unique_Filename(New_Contents, Size2);
            Set_Contents_File_Name(Node_Just_Created, New_Contents(1 .. Size2))
                ;
            Cais_Utilities.Copy(Old_Contents(1 .. Size1), New_Contents(1 ..
                Size2));
        end if;


        Get_Node_Relations(From, Relation_List);
        for I in 1 .. Length(Relation_List) loop
            Item_Name(Relation_List, I, Rel_Name);
            Extract(Relation_List, I, Key_List);
            for J in 1 .. Length(Key_List) loop
                Item_Name(Key_List, J, Key_Name);
                Get_A_Relationship(From, To_Text(Rel_Name), To_Text(Key_Name),
                    Old_Shadow_File, Rel_Attr, Primary);
                if Primary then
                    Open(Old_Node_To_Copy, From, To_Text(Key_Name), To_Text(
                        Rel_Name));
                    Copy_Sub_Tree(Old_Node_To_Copy, Node_Just_Created, To_Text(
                        Key_Name), To_Text(Rel_Name), New_Node_Copied);
                                                         --Recursive Call!!

                    Get_Shadow_File_Name(New_Node_Copied, New_Shadow_File, Size)
                        ;
                    Save_Shadows(New_Shadow_File, Old_Shadow_File);

                    Close(Old_Node_To_Copy);
                    Close(New_Node_Copied);
                end if;
            end loop;       --check all keys
        end loop;               --check all relations
    end Copy_Sub_Tree;


    procedure Add_Relationships(From   : Node_Type;
                                Target : in out Node_Type) is
        Next_From     : Node_Type;
        Next_Target   : Node_Type;

        Relation_List : List_Type;
        Key_List      : List_Type;
        Rel_Name      : Token_Type;
        Key_Name      : Token_Type;
        Rel_Attr      : List_Type;
        Primary       : Boolean := True;
        Shadow_File   : String(1 .. Max_Shadow_File_Length);
        Size          : Natural range 1 .. Max_Shadow_File_Length := 1;
    begin
        Get_Node_Relations(From, Relation_List);
        for I in 1 .. Length(Relation_List) loop
            Item_Name(Relation_List, I, Rel_Name);
            Extract(Relation_List, I, Key_List);
            for J in 1 .. Length(Key_List) loop
                Item_Name(Key_List, J, Key_Name);

                Get_A_Relationship(From, To_Text(Rel_Name), To_Text(Key_Name),
                    Shadow_File, Rel_Attr, Primary);
                if Primary then
                    Open(Next_From, From, To_Text(Key_Name), To_Text(Rel_Name))
                        ;
                    Open(Next_Target, Target, To_Text(Key_Name), To_Text(
                        Rel_Name), (1 => Read, 2 => Write_Relationships));

                    Get_Shadow_File_Name(Next_Target, Shadow_File, Size);
                    Set_A_Relationship(Target, To_Text(Rel_Name), To_Text(
                        Key_Name), Rel_Attr, Primary, Shadow_File);
                    Add_Relationships(Next_From, Next_Target);
                                                              --Recursive Call!!
                    Close(Next_From);
                else
                    Set_A_Relationship(Target, To_Text(Rel_Name), To_Text(
                        Key_Name), Rel_Attr, Primary, Check_Shadow(Shadow_File))
                        ;
                end if;
            end loop;       --check all keys
        end loop;               --check all relations
        Close(Target);
    end Add_Relationships;


begin
    if not Is_Open(From) then                           --From and Base must be
        raise Node_Definitions.Status_Error;            --open. Create checks
    end if;                                             --Base.


    -- Make sure that Name_Error conditions don't exist for the target.
    -- Note Create also checks for existence of the relationship.  This
    -- check is made here so that the Intent of the From node
    -- may be checked in the order required by MIL-STD-CAIS
    Check_Name : begin
      --First Check for syntax errors in the Relation and Key parameter
      --To_Token raises Use_Error for improper syntax
        To_Token(To_Relation, Syntax_Check);
        To_Token(To_Key, Syntax_Check);

      --Now Make sure the relationship doesn't exist.
        Node_Representation.Get_A_Relationship(Node => To_Base, Rel_Name =>
            To_Relation, Rel_Key => To_Key, Rel_Attributes => Rel_Attr, Primary
            => Primary, Shadow_File => Shadow_File);
        -- if we get here, the specified relationship already exists.
        -- This procedure call is history...
        raise Node_Definitions.Name_Error;
    exception
        when Node_Definitions.Use_Error =>
            raise Node_Definitions.Name_Error;
        when No_Such_Relation | No_Such_Relationship =>
            null;  -- the relationship does NOT exist...
    end Check_Name;

                        --Check File Kind. Create same kind of node or
                        --raise Use_Error for process nodes. Create checks
                        --Base and checks that To_Relation is not predefined
    Kind := Get_Kind(From);
    if Kind /= Structural and then Kind /= File then
        raise Node_Definitions.Use_Error;
    end if;

    Cais_Utilities.Check_Intentions(From, Read);        --Insure proper intent
                                                        --Create checks Base.


    --First recurse thru the tree marking each node, and locking access
    Mark_Tree(From);                                    --Recursive procedure!!

    --Now that access to all nodes is guaranteed, recursively copy them
    Copy_Sub_Tree(From, To_Base, To_Key, To_Relation, New_Node);
                                                        --Recursive procedure!!
    Get_Shadow_File_Name(From, Old_Shadow_File, Size);
    Get_Shadow_File_Name(New_Node, New_Shadow_File, Size);
    Save_Shadows(New_Shadow_File, Old_Shadow_File);

    --Now Adjust relationships by copying attributes for Primary ones and
    --    by copying 2ndary ones with updated references within the tree.
    Add_Relationships(From, New_Node);
                                                        --Recursive procedure!!

end Copy_Tree;
--::::::::::::::
--create_node.a
--::::::::::::::

----------------------------------------------------------------------
--                      C R E A T E _ N O D E
--              (Separate procedure in Node_Internals)
--
--
--                    Creates a node and installs the
--                       primary relationship to it.
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Tue Jul 16 13:28:05 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------  C R E A T E _ N O D E  ----------------------
--
--  Purpose:
--  -------
--    This procedure creates a node and installs the
--    primary relationship to it.  The relation name and relationship
--    key of the primary relationship to the node and the base node
--    from which it emanates are given by the parameters Relation,
--    Key, and Base.  An open node handle to the newly created node
--    with WRITE intent is returned in Node.
--
--  Parameters:
--  ----------
--    Node        closed node handle to be opened to the new node
--    Base        open node handle to the node from which the primary
--            relationship to the new node is to emanate
--    Kind        the Node_Kind of the new node
--    Internals_Attributes  Node attributes that are NOT settable
--                by the user or that are part of the implementation.
--    User_Attributes  Node attributes that are settable by the user.
--    Key         relationship key of the primary relation to be created
--    Relation    relation name of the primary relation to be created
--
--  Exceptions:  (All Node_Definitions.-)
--  ----------
--    NAME_ERROR        - if a node exists for the node identification
--                        given, if the node identification is illegal.
--    SECURITY_VIOLATION  if the operation violates mandatory access
--                        controls; raised only if conditions for other
--                        exceptions are not met.
--    USE_ERROR         if the User_Attributes list includes invalid
--                      node attributes or attributes not user-settable.
--
--  Notes:
--  -----
--     The calling routine is responsible for creating the
--     contents file if this is a FILE node.
--
---------------------------------------------------------------------

separate(Cais.Node_Internals)
procedure Create_Node(Node                 : in out Node_Type;
                      Base                 : in out Node_Type;
                      Kind                 : Node_Kind;
                      Internals_Attributes : List_Type;
                      User_Attributes      : List_Type;
                      Internals_Relations  : List_Type;
                      Intent               : Intention;
                      Access_Control       : List_Type;
                      Level                : List_Type;
                      Key                  : String;
                      Relation             : String) is

    use Pragmatics;
    use Cais_Internals_Exceptions;
    use Cais_Host_Dependent;
    use Trace;
    use Cais_Utilities;
    use Attributes;


    Shadow_File       : String(1 .. Max_Shadow_File_Length);
    New_Shadow_File   : String(1 .. Max_Shadow_File_Length);
    Shadow_Length     : Natural;
    Is_Primary        : Boolean;
    Rel_Attributes    : List_Type;
    Simple_List       : List_Type;
    Base_Attributes   : List_Type;
    New_Shadow_Length : Natural;

begin
    if Node_Representation.Open_Status(Node) or not Node_Representation.
        Open_Status(Base) then
        raise Node_Definitions.Status_Error;
    end if;
    Cais_Utilities.Check_Intentions(Base, Append_Relationships);

    -- Verify that the Key and Rel strings are syntactically valid
    if not Valid_Relation_Name (Relation) or
    not Valid_Relation_Key (Key) then
    raise Node_Definitions.Name_Error;
    end if;

    -- verify that the specified relation is not a predefined one that
    -- the user cannot set.
    if Predefined(Relation, Cais_Utilities.Relation) then
        raise Node_Definitions.Use_Error;
    end if;

    -- see if rel and key for base refer to existing node
    Check_Relationship : begin
        Node_Representation.Get_A_Relationship(Node => Base, Rel_Name =>
            Relation, Rel_Key => Key, Rel_Attributes => Base_Attributes, Primary
            => Is_Primary, Shadow_File => Shadow_File);
        -- if we get here, the specified relationship already exists.
        -- This procedure call is history...
        raise Node_Definitions.Name_Error;
    exception
        -- exceptions that are trapped (nothing propogated)
        when No_Such_Relation | No_Such_Relationship =>
            null;  -- the relationship does NOT exist...

        -- exceptions that are propogated
        when Name_Error =>
            raise;

        -- exceptions that are mapped to other exceptions
        when Use_Error =>   -- something was wrong with the rel or key
            raise Name_Error;
        -- predefined exceptions (propogated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Node_Internals.Create_Node");
            raise;
        -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Node_Internals.Create_Node"
                );
            raise Trace.Assertion_Violation;
    end Check_Relationship;

    -- Set the supplied values for the new node
    Set_Open(Node, True);
    Set_Intent(Node, (1 => Append_Attributes));
    Set_Node_Level(Node, Level);
    Set_Kind(Node, Kind);
    Set_Node_Access_Control(Node, Access_Control);
    Set_Node_Relations(Node, Internals_Relations);
    Set_Node_Attributes(Node, Internals_Attributes);

    -- build a pathname from the base, relation, and key...
    Build_Name : declare
        Name                                : String(1 .. Max_Name_String);
        Name_Length, Rel_Length, Key_Length : Natural;
    begin
        Get_Pathname(Base, Name, Name_Length);
        Rel_Length := Last_Non_Space(Relation);
        Key_Length := Last_Non_Space(Key);
        Set_Pathname(Node, Name(1 .. Name_Length) & "'" & Relation(Relation'
            First .. Rel_Length) & "(" & Key(Key'First .. Key_Length) & ")");
    end Build_Name;

    -- loop through User_Attributes, using create to add them...
    Add_Attributes : declare
        Attribute_Token : Token_Type;
        Attribute_Count : List_Utilities.Count;
        Attribute_Value : List_Type;
    begin
        for I in 1 .. Length(User_Attributes) loop
            Extract(User_Attributes, I, Attribute_Value);
            Item_Name(User_Attributes, I, Attribute_Token);
            Create_Node_Attribute(Node, Identifier_Items.To_Text(Attribute_Token
                ), Attribute_Value);
        end loop;
    exception
        -- Use_Error is raised if the attribute is predefined or exists
        when Node_Definitions.Use_Error =>
            raise;
        when others =>
            Trace.Report("Node_Internals.Create_Node add_attributes");
            raise Trace.Assertion_Violation;
    end Add_Attributes;

    -- create a shadow file for the new node
    Cais_Host_Dependent.Get_Unique_Filename(New_Shadow_File, New_Shadow_Length)
        ;
    Set_Shadow_File_Name(Node, New_Shadow_File(1 .. New_Shadow_Length));

    -- Attributes of the Parent relation are the Kind (standard for all
    -- relations), and the primary relationship and key from the parent
    -- node that designates this new node
    Get_Shadow_File_Name(Base, Shadow_File, Shadow_Length);
    Copy(Rel_Attributes, Empty_List);
    Cais_Utilities.String_To_Simple_List(Node_Kind'Image(Get_Kind(Base)),
        Simple_List);
    Insert(Rel_Attributes, Simple_List, "Kind", 0);
    Cais_Utilities.String_To_Simple_List(Relation, Simple_List);
    Insert(Rel_Attributes, Simple_List, "Primary_Relation", 0);
    Cais_Utilities.String_To_Simple_List(Key, Simple_List);
    Insert(Rel_Attributes, Simple_List, "Primary_Key", 0);
    Set_A_Relationship(Node => Node, Rel_Name => "Parent", Rel_Key => "",
        Rel_Attributes => Rel_Attributes, Primary => False, Shadow_File =>
        Shadow_File(1 .. Shadow_Length));

    Write_Shadow_File(Node);

    -- Leave node open with requested intent
    Set_Intent(Node, (1 => Existence)); -- Reset first association
    Set_Intent(Node, Intent);

    -- Add this primary relationship to the Base node
    Cais_Utilities.String_To_Simple_List(Node_Kind'Image(Kind), Simple_List);
    Copy(Rel_Attributes, Empty_List);
    Insert(Rel_Attributes, Simple_List, "Kind", 0);
    Set_A_Relationship(Node => Base, Rel_Name => Relation, Rel_Key => Key,
        Rel_Attributes => Rel_Attributes, Primary => True, Shadow_File =>
        New_Shadow_File(1 .. New_Shadow_Length));
    Write_Shadow_File(Base);

exception
    -- exceptions that are trapped (nothing propagated)
    -- exceptions that are propagated
    when Node_Definitions.Status_Error | Node_Definitions.Use_Error |
        Node_Definitions.Intent_Violation | Node_Definitions.Name_Error |
        Node_Definitions.Security_Violation =>
        Set_Open(Node, False);
        raise;
    -- exceptions that are mapped to other exceptions
    when Cais_Internals_Exceptions.No_Such_Shadow_File =>
        Set_Open(Node, False);
        raise Node_Definitions.Name_Error;
    -- predefined exceptions (propagated with trace)
    when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
        Numeric_Error =>
        Set_Open(Node, False);
        Trace.Report("PREDEFINED EXCEPTION in Node_Internals.Create_Node ");
        raise;
    -- unanticipated exceptions
    when others =>
        Set_Open(Node, False);
        Trace.Report("UNANTICIPATED EXCEPTION in Node_Internals.Create_Node ");
        raise Trace.Assertion_Violation;

end Create_Node;
--::::::::::::::
--cset.a
--::::::::::::::
-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : CHARACTER_SET
-- Version      : 1.1
-- Author       : Richard Conn
--              : Texas Instruments, Ada Technology Branch
--              : PO Box 801, MS 8007
--              : McKinney, TX  75069
-- DDN Address  : RCONN at SIMTEL20
-- Copyright    : (c) 1985 Richard Conn
-- Date created : 15 Feb 85
-- Release date : 15 Feb 85
-- Last update  : 25 Feb 85
-- Machine/System Compiled/Run on : DG MV 10000, ROLM ADE
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :
----------------: character, character set
--
-- Abstract     : CHARACTER_SET provides a number of test routines
----------------: which determine if a given character falls into
-- a particular class of characters.  See the visible section for
-- details.  It also provides routines for character and string
-- letter case conversion (to lower case, to upper case) and for
-- naming control characters.
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION AUTHOR                  HISTORY
-- 2/15/85      1.0     Richard Conn            Initial Release
-- 2/25/85      1.1     Richard Conn            Cosmetic, Readability Changes
-- 4/10/85      1.2     C. Howell           added Last_Non_Space
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------
--
-- Components Package CHARACTER_SET
-- by Richard Conn, TI Ada Technology Branch
-- Version 1.1, Date 25 Feb 85
-- Version 1.0, Date 13 Feb 85
--
package CHARACTER_SET is

--
-- These routines test for the following subsets of ASCII
--
-- Routine              Subset tested for
-- =======              =================
-- ALPHA                'a'..'z' | 'A'..'Z'
-- ALPHA_NUMERIC        ALPHA | '0'..'9'
-- CONTROL              < ' ' | DEL
-- DIGIT                '0'..'9'
-- GRAPHIC              ' ' < ch < DEL (does not include space)
-- HEXADECIMAL          DIGIT | 'A'..'F' | 'a'..'f'
-- LOWER                'a'..'z'
-- PRINTABLE            GRAPHIC | ' '
-- PUNCTUATION          GRAPHIC and not ALPHA_NUMERIC
-- SPACE                HT | LF | VT | FF | CR | ' '
-- UPPER                'A'..'Z'
--
    function IS_ALPHA         (CH : CHARACTER) return BOOLEAN;
    function IS_ALPHA_NUMERIC (CH : CHARACTER) return BOOLEAN;
    function IS_CONTROL       (CH : CHARACTER) return BOOLEAN;
    function IS_DIGIT         (CH : CHARACTER) return BOOLEAN;
    function IS_GRAPHIC       (CH : CHARACTER) return BOOLEAN;
    function IS_HEXADECIMAL   (CH : CHARACTER) return BOOLEAN;
    function IS_LOWER         (CH : CHARACTER) return BOOLEAN;
    function IS_PRINTABLE     (CH : CHARACTER) return BOOLEAN;
    function IS_PUNCTUATION   (CH : CHARACTER) return BOOLEAN;
    function IS_SPACE         (CH : CHARACTER) return BOOLEAN;
    function IS_UPPER         (CH : CHARACTER) return BOOLEAN;

--
-- These routines convert characters and strings to upper- or lower-case
--
    function  TO_LOWER (CH : CHARACTER) return CHARACTER;
    procedure TO_LOWER (CH : in out CHARACTER);
    procedure TO_LOWER (STR : in out STRING);
    function  TO_UPPER (CH : CHARACTER) return CHARACTER;
    procedure TO_UPPER (CH : in out CHARACTER);
    procedure TO_UPPER (STR : in out STRING);

--
-- These routines return the names of the control characters
--
    subtype CONTROL_CHARACTER_NAME_2 is STRING (1 .. 2);
    subtype CONTROL_CHARACTER_NAME_3 is STRING (1 .. 3);
--
    function CC_NAME_2 (CH : CHARACTER) return CONTROL_CHARACTER_NAME_2;
    function CC_NAME_3 (CH : CHARACTER) return CONTROL_CHARACTER_NAME_3;

-- This routine returns the offset (from the first character) of the
-- last non_space character.   CCH 4/10/85
    function Last_Non_Space (Str : String) return Integer;


end CHARACTER_SET;

package body CHARACTER_SET is

    function IS_ALPHA (CH : CHARACTER) return BOOLEAN is
    begin
        case CH is
            when 'a' .. 'z' =>
                return TRUE;
            when 'A' .. 'Z' =>
                return TRUE;
            when others =>
                return FALSE;
        end case;
    end IS_ALPHA;

    function IS_ALPHA_NUMERIC (CH : CHARACTER) return BOOLEAN is
    begin
        case CH is
            when 'a' .. 'z' =>
                return TRUE;
            when 'A' .. 'Z' =>
                return TRUE;
            when '0' .. '9' =>
                return TRUE;
            when others =>
                return FALSE;
        end case;
    end IS_ALPHA_NUMERIC;

    function IS_CONTROL (CH : CHARACTER) return BOOLEAN is
    begin
        if CH < ' ' or CH = ASCII.DEL then
            return TRUE;
        else
            return FALSE;
        end if;
    end IS_CONTROL;

    function IS_DIGIT (CH : CHARACTER) return BOOLEAN is
    begin
        if CH in '0' .. '9' then
            return TRUE;
        else
            return FALSE;
        end if;
    end IS_DIGIT;

    function IS_GRAPHIC (CH : CHARACTER) return BOOLEAN is
    begin
        if CH > ' ' and CH < ASCII.DEL then
            return TRUE;
        else
            return FALSE;
        end if;
    end IS_GRAPHIC;

    function IS_HEXADECIMAL (CH : CHARACTER) return BOOLEAN is
    begin
        case CH is
            when '0' .. '9' =>
                return TRUE;
            when 'A' .. 'F' | 'a' .. 'f' =>
                return TRUE;
            when others =>
                return FALSE;
        end case;
    end IS_HEXADECIMAL;

    function IS_LOWER (CH : CHARACTER) return BOOLEAN is
    begin
        if CH in 'a' .. 'z' then
            return TRUE;
        else
            return FALSE;
        end if;
    end IS_LOWER;

    function IS_PRINTABLE (CH : CHARACTER) return BOOLEAN is
    begin
        if CH >= ' ' and CH < ASCII.DEL then
            return TRUE;
        else
            return FALSE;
        end if;
    end IS_PRINTABLE;

    function IS_PUNCTUATION (CH : CHARACTER) return BOOLEAN is
    begin
        if (CH > ' ') and (CH < ASCII.DEL) and (not IS_ALPHA_NUMERIC (CH)) then
            return TRUE;
        else
            return FALSE;
        end if;
    end IS_PUNCTUATION;

    function IS_SPACE (CH : CHARACTER) return BOOLEAN is
    begin
        case CH is
            when ASCII.HT =>
                return TRUE;
            when ASCII.LF =>
                return TRUE;
            when ASCII.VT =>
                return TRUE;
            when ASCII.FF =>
                return TRUE;
            when ASCII.CR =>
                return TRUE;
            when ' ' =>
                return TRUE;
            when others =>
                return FALSE;
        end case;
    end IS_SPACE;

    function IS_UPPER (CH : CHARACTER) return BOOLEAN is
    begin
        if CH in 'A' .. 'Z' then
            return TRUE;
        else
            return FALSE;
        end if;
    end IS_UPPER;

    function TO_LOWER (CH : CHARACTER) return CHARACTER is
    begin
        if IS_UPPER (CH) then
            return CHARACTER'VAL
                     (CHARACTER'POS (CH) - CHARACTER'POS ('A') +
                      CHARACTER'POS ('a'));
        else
            return CH;
        end if;
    end TO_LOWER;

    procedure TO_LOWER (CH : in out CHARACTER) is
    begin
        if IS_UPPER (CH) then
            CH := TO_LOWER (CH);
        end if;
    end TO_LOWER;

    procedure TO_LOWER (STR : in out STRING) is
    begin
        for I in STR'FIRST .. STR'LAST loop
            STR (I) := TO_LOWER (STR (I));
        end loop;
    end TO_LOWER;

    function TO_UPPER (CH : CHARACTER) return CHARACTER is
    begin
        if IS_LOWER (CH) then
            return CHARACTER'VAL
                     (CHARACTER'POS (CH) - CHARACTER'POS ('a') +
                      CHARACTER'POS ('A'));
        else
            return CH;
        end if;
    end TO_UPPER;

    procedure TO_UPPER (CH : in out CHARACTER) is
    begin
        if IS_LOWER (CH) then
            CH := TO_UPPER (CH);
        end if;
    end TO_UPPER;

    procedure TO_UPPER (STR : in out STRING) is
    begin
        for I in STR'FIRST .. STR'LAST loop
            STR (I) := TO_UPPER (STR (I));
        end loop;
    end TO_UPPER;

    function CC_NAME_2 (CH : CHARACTER) return CONTROL_CHARACTER_NAME_2 is
        NAME : CONTROL_CHARACTER_NAME_2;
    begin
        case CH is
            when ASCII.NUL =>  NAME := "^@";
            when ASCII.SOH =>  NAME := "^A";
            when ASCII.STX =>  NAME := "^B";
            when ASCII.ETX =>  NAME := "^C";
            when ASCII.EOT =>  NAME := "^D";
            when ASCII.ENQ =>  NAME := "^E";
            when ASCII.ACK =>  NAME := "^F";
            when ASCII.BEL =>  NAME := "^G";
            when ASCII.BS =>  NAME := "^H";
            when ASCII.HT =>  NAME := "^I";
            when ASCII.LF =>  NAME := "^J";
            when ASCII.VT =>  NAME := "^K";
            when ASCII.FF =>  NAME := "^L";
            when ASCII.CR =>  NAME := "^M";
            when ASCII.SO =>  NAME := "^N";
            when ASCII.SI =>  NAME := "^O";
            when ASCII.DLE =>  NAME := "^P";
            when ASCII.DC1 =>  NAME := "^Q";
            when ASCII.DC2 =>  NAME := "^R";
            when ASCII.DC3 =>  NAME := "^S";
            when ASCII.DC4 =>  NAME := "^T";
            when ASCII.NAK =>  NAME := "^U";
            when ASCII.SYN =>  NAME := "^V";
            when ASCII.ETB =>  NAME := "^W";
            when ASCII.CAN =>  NAME := "^X";
            when ASCII.EM =>  NAME := "^Y";
            when ASCII.SUB =>  NAME := "^Z";
            when ASCII.ESC =>  NAME := "^[";
            when ASCII.FS =>  NAME := "^\";
            when ASCII.GS =>  NAME := "^]";
            when ASCII.RS =>  NAME := "^^";
            when ASCII.US =>  NAME := "^_";
            when ASCII.DEL =>  NAME := "^`";
            when others =>
                NAME := "  ";
                NAME (2) := CH;
        end case;
        return NAME;
    end CC_NAME_2;

    function CC_NAME_3 (CH : CHARACTER) return CONTROL_CHARACTER_NAME_3 is
        NAME : CONTROL_CHARACTER_NAME_3;
    begin
        case CH is
            when ASCII.NUL =>  NAME := "NUL";
            when ASCII.SOH =>  NAME := "SOH";
            when ASCII.STX =>  NAME := "STX";
            when ASCII.ETX =>  NAME := "ETX";
            when ASCII.EOT =>  NAME := "EOT";
            when ASCII.ENQ =>  NAME := "ENQ";
            when ASCII.ACK =>  NAME := "ACK";
            when ASCII.BEL =>  NAME := "BEL";
            when ASCII.BS =>  NAME := "BS ";
            when ASCII.HT =>  NAME := "HT ";
            when ASCII.LF =>  NAME := "LF ";
            when ASCII.VT =>  NAME := "VT ";
            when ASCII.FF =>  NAME := "FF ";
            when ASCII.CR =>  NAME := "CR ";
            when ASCII.SO =>  NAME := "SO ";
            when ASCII.SI =>  NAME := "SI ";
            when ASCII.DLE =>  NAME := "DLE";
            when ASCII.DC1 =>  NAME := "DC1";
            when ASCII.DC2 =>  NAME := "DC2";
            when ASCII.DC3 =>  NAME := "DC3";
            when ASCII.DC4 =>  NAME := "DC4";
            when ASCII.NAK =>  NAME := "NAK";
            when ASCII.SYN =>  NAME := "SYN";
            when ASCII.ETB =>  NAME := "ETB";
            when ASCII.CAN =>  NAME := "CAN";
            when ASCII.EM =>  NAME := "EM ";
            when ASCII.SUB =>  NAME := "SUB";
            when ASCII.ESC =>  NAME := "ESC";
            when ASCII.FS =>  NAME := "FS ";
            when ASCII.GS =>  NAME := "GS ";
            when ASCII.RS =>  NAME := "RS ";
            when ASCII.US =>  NAME := "US ";
            when ASCII.DEL =>  NAME := "DEL";
            when others =>
                NAME := "   ";
                NAME (2) := CH;
        end case;
        return NAME;
    end CC_NAME_3;

-- This routine returns the offset (from the first character) of the
-- last non_space character.   CCH 4/10/85
    function Last_Non_Space (Str : String) return Integer is
    Tmp : Integer;
    begin
    Tmp := Str'last ;
    for I in reverse Str'range loop
        exit when not Is_Space (Str(I)) ;
        Tmp := Tmp - 1;
    end loop;
    return (Tmp);
    end Last_Non_Space;

end CHARACTER_SET;
--::::::::::::::
--delete_node.a
--::::::::::::::

----------------------------------------------------------------------
--                     D E L E T E _ N O D E
--           (Separate procedure in Node_Management)
--
--
--               Deletes the primary relationship to a node.
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Wed Jun 26 09:10:14 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

----------------------   D E L E T E _ N O D E ----------------------
--
--  Purpose:
--  -------
--    This procedure deletes the primary relationship to a node
--    identified by Node.  The node becomes unobtainable.  The node
--    handle Node is closed.  If the node is a process node and the
--    process is not yet terminated (see Section 5.2 of MIL-STD-CAIS),
--    Delete_Node aborts the process.
--
--  Parameters:
--  ----------
--    Node  - an open node handle to the node which is the target of
--            the primary relationship to be deleted.
--
--  Exceptions:
--  ----------
--    (all defined in Node_Definitions)
--    Name_Error          - if parent node of Node is inaccessable
--    Use_Error           - if any primary Relationships emanate from Node
--    Status_Error        - if Node is not open
--    Lock_Error          - if access, with intent Write_Relationships,
--                          to the parent of the node to be deleted
--                          cannot be obtained due to an existing lock
--                          on the node.
--    Intent_Violation    - if the node handle Node was not opened with
--                          an intent including Exclusive_Write and
--                          Read_Relationships.
--    Access_Violation    - if the current process does not have sufficient
--                          discretionary access control rights to obtain
--                          access to the parent of the node to be deleted
--                          with intent Write_Relationships and the
--                          conditions for Name_Error are not present.
--    Security_Violation  - if the operation represents a violation of
--                          mandatory access controls.  Security_Violation
--                          is raised only if the conditions for other
--                          exceptions are not present.
--
--  Notes:
--  -----
--    MIL-STD-CAIS 5.1.2.21
---------------------------------------------------------------------

separate(Cais.Node_Management)
procedure Delete_Node(Node : in out Node_Type) is

    use Attributes;
    use List_Utilities;
    use Standard.Text_Io;


    Parent_Node      : Node_Type;
    Shadow_File      : String(1 .. Max_Shadow_File_Length);
    Contents_File    : String(1 .. Max_Contents_File_Length);
    Name_Length      : Natural;
    Node_Relations   : List_Type;
    Simple_List      : List_Type;
    Primary_Key      : String(1 .. Max_Relationship_Key);
    Phyl             : File_Type;
    Primary_Relation : String(1 .. Max_Relationship_Name);
begin

    -- check_intentions for Exclusive_Write and Read_Relationships
    -- (Status_Error is raised if the node is not open...)
    Cais_Utilities.Check_Intentions(Node, Exclusive_Write);
    Cais_Utilities.Check_Intentions(Node, Read_Relationships);

    -- if any of the relationships emanating from this node are
    -- primary relationships, raise Node_Definitions.Use_Error
    Check_For_Primary : declare
        Relationship, Relation : List_Type;
    begin
        Get_Node_Relations(Node, Node_Relations);
        for Relation_Count in 1 .. Length(Node_Relations) loop
            Extract(Node_Relations, Relation_Count, Relation);
            for Relationship_Count in 1 .. Length(Relation) loop
                Extract(Relation, Relationship_Count, Relationship);
                Test_Relationship : begin
                    Replace(Relationship, Empty_List, Node_Representation.
                        Primary_Rel);
                    -- if we get here, there IS a primary relationship
                    -- from this node.  Time to raise the exception
                    raise Node_Definitions.Use_Error;
                exception
                    when Search_Error =>
                        -- Primary_Rel was not found (good!)
                        null;
                end Test_Relationship;
            end loop; --for Relationship_Count in 1 .. Length (Relation)
        end loop;  -- for i in 1 .. Length (Node_Relations)
    end Check_For_Primary;


    -- get primary rel from parent to this node...
    Get_Path_Attribute(Base => Node, Key => "", Relation => "Parent", Attribute
        => "Primary_Relation", Value => Simple_List);
    Cais_Utilities.Simple_List_To_String(Simple_List, Primary_Relation);
    Get_Path_Attribute(Base => Node, Key => "", Relation => "Parent", Attribute
        => "Primary_Key", Value => Simple_List);
    Cais_Utilities.Simple_List_To_String(Simple_List, Primary_Key);


    Open(Node => Parent_Node, Base => Node, Key => "", Relation => "Parent",
        Intent => (1 => Read_Relationships, 2 => Write_Relationships));

    -- remove the primary rel pointing to this node
    Delete_A_Relationship(Node => Parent_Node, Rel_Name => Primary_Relation,
        Rel_Key => Primary_Key);
    Write_Shadow_File(Parent_Node);

    Get_Shadow_File_Name(Node, Shadow_File, Name_Length);
    if Name_Length > 1 then
        Open(Phyl, Out_File, Shadow_File(1 .. Name_Length));
        Delete(Phyl);
    end if;

    Get_Contents_File_Name(Node, Contents_File, Name_Length);
    if Name_Length > 1 then
        Open(Phyl, Out_File, Contents_File(1 .. Name_Length));
        Delete(Phyl);
    end if;

    Set_Open(Node, False);

end Delete_Node;
--::::::::::::::
--delete_tree.a
--::::::::::::::


----------------------------------------------------------------------
--                   D E L E T E _ T R E E
--           (Separate procedure in Node_Management)
--
--
--  Deletes the all nodes emanating from a given node (+ associated subtrees)
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Wed Jun 26 09:10:14 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------   D E L E T E _ T R E E ----------------------
--
--  Purpose:
--  -------
--    This procedure effectively performs the Delete_Node operation for
--    a specified node and recursively applies Delete_Tree to all nodes
--    reachable by a unique primary pathname from the designated node.
--    The nodes whose primary relationships are to be deleted are opened
--    with intent Exclusive_Write, thus locking them for other operations.
--    The order in which the deletions of primary relationships is performed
--    is not specified.  If the Delete_Tree operation raises an exception,
--    none of the primary relationships is deleted.
--
--  Parameters:
--  ----------
--    Node  - an open node handle to the node at the root of the tree
--            whose primary relationships are to be deleted.
--
--  Exceptions:
--  ----------
--    (all defined in Node_Definitions)
--    Name_Error          - if parent node of Node or any of the target nodes of
--                primary relationships to be deleted are inaccessable
--    Use_Error           - if the primary Relationship of Node belongs to a
--                predefined relation that cannot be modified by the
--                user.
--    Status_Error        - if Node is not open
--    Lock_Error          - if access, with intent Write_Relationships,
--                          to the parent of the "Node" cannot be obtained due
--                to an existing lock or if a node handle identifying
--                any node whose unique primary path traverses the
--                node identified by Node cannot be opened with intent
--                Exclisive_Write.
--    Intent_Violation    - if the node handle Node was not opened with
--                          an intent including Exclusive_Write and
--                          Read_Relationships.
--    Access_Violation    - if the current process does not have sufficient
--                          discretionary access control rights to obtain
--                          access to the parent of the node specified by Node
--                          with intent Write_Relationships or to obtain
--                access to any target node of a primary relationship
--                to be deleted with the intent Exclusive_Write and
--                the conditions for Name_Error are not present.
--    Security_Violation  - if the operation represents a violation of
--                          mandatory access controls.  Security_Violation
--                          is raised only if the conditions for other
--                          exceptions are not present.
--
--  Notes:
--  -----
--    MIL-STD-CAIS 5.1.2.22
--     Locking support will have to be added here...
---------------------------------------------------------------------
separate(Cais.Node_Management)
procedure Delete_Tree(Node : in out Node_Type) is
    use Attributes;
    use Identifier_Items;
    Parent_Node      : Node_Type;
    Primary_Relation : String(1 .. Max_Relationship_Name);
    Primary_Key      : String(1 .. Max_Relationship_Key);
    Simple_List      : List_Type;


    package Shadows is
        procedure Save_Shadows(Shadow : String);
        procedure Delete_Shadows;
    end Shadows;

    package body Shadows is
        type Shadow_Link;
        type Shadow_List is access Shadow_Link;
        type Shadow_Link is
            record
                A_Shadow    : String(1 .. Max_Shadow_File_Length);
                Next_Shadow : Shadow_List;
            end record;
        Shadows : Shadow_List;

        procedure Save_Shadows(Shadow : String) is
            New_Record : Shadow_List := new Shadow_Link'(Shadow, Shadows);
        begin
            Shadows := New_Record;
        end Save_Shadows;

        procedure Delete_Shadows is
            Current_Record : Shadow_List := Shadows;
            Phyl           : File_Type;
        begin
            while Current_Record /= null loop
                Open(Phyl, Out_File, Current_Record.A_Shadow(1 .. Last_Non_Space
                    (Current_Record.A_Shadow)));
                Delete(Phyl);

                Current_Record := Current_Record.Next_Shadow;
            end loop;
        end Delete_Shadows;

    end Shadows;
    use Shadows;
    procedure Mark_Tree(Node : Node_Type) is
        Node_To_Copy  : Node_Type;
        Relation_List : List_Type;
        Key_List      : List_Type;
        Rel_Name      : Token_Type;
        Key_Name      : Token_Type;
        Rel_Attr      : List_Type;
        Primary       : Boolean;
        Shadow_File   : String(1 .. Max_Shadow_File_Length);
        Size          : Natural;
    begin
        Get_Shadow_File_Name(Node, Shadow_File, Size);
        Save_Shadows(Shadow_File);
        if Get_Kind(Node) = File then
            Get_Contents_File_Name(Node, Shadow_File, Size);
            Save_Shadows(Shadow_File);
        end if;

        Get_Node_Relations(Node, Relation_List);
        for I in 1 .. Length(Relation_List) loop
            Item_Name(Relation_List, I, Rel_Name);
            Extract(Relation_List, I, Key_List);
            for J in 1 .. Length(Key_List) loop
                Item_Name(Key_List, J, Key_Name);
                Get_A_Relationship(Node, To_Text(Rel_Name), To_Text(Key_Name),
                    Shadow_File, Rel_Attr, Primary);
                if Primary then
                --!hack --Reports both Lock Error and Access_Violations
                --!hack Mark_Access(Shadow_File, Exclusive_Write);

                    Set_Shadow_File_Name(Node_To_Copy, Shadow_File);
                    begin
                        --Gaurd against non-existant shadow file for node
                        Read_Shadow_File(Node_To_Copy);
                    exception
                        when No_Such_Shadow_File =>
                            raise Node_Definitions.Name_Error;
                    end;
                    Mark_Tree(Node_To_Copy);            --Recursive Call!!
                end if;
            end loop;       --check all keys
        end loop;       --check all relations
    end Mark_Tree;

begin
--************           Check for exceptional conditions        **************
    --make sure Node is open
    if not Is_Open(Node) then
        raise Node_Definitions.Status_Error;
    end if;

    -- get primary rel from parent to this node. Verify it isn't predefined
    Get_Path_Attribute(Node, "", "Parent", "Primary_Relation", Simple_List);
    Cais_Utilities.Simple_List_To_String(Simple_List, Primary_Relation);
    Get_Path_Attribute(Node, "", "Parent", "Primary_Key", Simple_List);
    Cais_Utilities.Simple_List_To_String(Simple_List, Primary_Key);
    if Predefined(Primary_Relation, Cais_Utilities.Relation) then
        raise Node_Definitions.Use_Error;
    end if;


    --First recurse thru the tree marking each node, locking access,
    --creating a list of all shadow_files (and content_files) to be deleted
    Mark_Tree(Node);                            --Recursive procedure!!





    --Next destroy primary links in parent of the top node in the tree

    -- check_intentions for Exclusive_Write and Read_Relationships
    Cais_Utilities.Check_Intentions(Node, Exclusive_Write);
    Cais_Utilities.Check_Intentions(Node, Read_Relationships);


    -- remove the primary rel pointing to this node. Lock_Error, Access Viol.
    Open(Parent_Node, Node, "", "Parent", (1 => Read_Relationships, 2 =>
        Write_Relationships));
    Delete_A_Relationship(Parent_Node, Primary_Relation, Primary_Key);
    Write_Shadow_File(Parent_Node);
    Close(Parent_Node);



    --Now, Simply delete all shadow and content files
    Delete_Shadows;

end Delete_Tree;
--::::::::::::::
--delete_user.a
--::::::::::::::
----------------------------------------------------------------------
--                     D E L E T E _ U S E R
--
--
--               CAIS tool to delete a user from the CAIS
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--                   Thu Feb 20 00:47:23 EST 1986
--
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
with Text_IO;
separate (Cais)
procedure Delete_User is

begin
    Standard.Text_Io.Put_Line ("Sorry, Delete_User is not working.");
end Delete_User;
--::::::::::::::
--direct_io_definitions_body.a
--::::::::::::::

----------------------------------------------------------------------
--                 D I R E C T _ I O _ D E F I N I T I O N S
--                            (Package Body)
--
--
--               This Package Defines the Types and Exceptions
--                      Associated with Direct File Handles
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--             Wed Oct  9 14:08:19 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--              D I R E C T _ I O _ D E F I N I T I O N S
--
--  Purpose:
--  -------
--      This package defines the types and exceptions associated with
--      Direct_Io file handles.
--
--  Usage:
--  -----
--    Package Cais.Direct_Io instantiates this package to produce
--    a new package Dir_Io_Definitions nested in the Cais.Direct_Io
--    specification.  For direct use of the base types and exceptions
--    used by Cais.Direct_Io, the user can refer to the instantiated
--    package.
--
--  Notes:
--  -----
--    This package  is added to the CAIS implementation
--    to provide distinct File_Types for each CAIS.Direct_Io
--    instantiation.  This is an alternative to the present
--    CAIS file handle usage, which differs substantially from
--    standard Ada Input/Output.
--    Ada generic I/O packages permit an unbounded number of
--    file types to be constructed.  The CAIS requires a single
--    file type to hide all file types, for use by  text and generic
--    instantiations of direct and sequential IO packages.
--    This implementation follows Ada.
--
--      The     use     of     a     limited     private     type
--      (Direct_Io_Definitions.File_Type)  implies  the addition of
--      subprograms to manipulate  that  type  (e.g.  to  set  or
--      extract  the  contents of an object of that type).  These
--      are in this specification, although they are additions to
--      the  CAIS  specification  for  this  package.
--
--      This is a version of the package Cais.IO_Definitions,
--      specified in MIL-STD-CAIS section 5.3.1
--
--  Revision History:
--  ----------------
--    None.
--
-------------------------------------------------------------------
with Unchecked_Deallocation;

separate(Cais)
package body Direct_Io_Definitions is

    use List_Utilities;

---------------------------------  Is_Space  ---------------------------------
--
--    Local version of  function from package Character_Set
--
-------------------------------------------------------------------------------

    function Is_Space(Ch : Character) return Boolean is
    begin
        case Ch is
            when Ascii.Ht =>
                return True;
            when Ascii.Lf =>
                return True;
            when Ascii.Vt =>
                return True;
            when Ascii.Ff =>
                return True;
            when Ascii.Cr =>
                return True;
            when ' ' =>
                return True;
            when others =>
                return False;
        end case;
    end Is_Space;


-------------------------  Last_Non_Space  ------------------------------------
--
--    Local version of  function from package Character_Set
--
-------------------------------------------------------------------------------

    function Last_Non_Space(Str : String) return Integer is
        Tmp : Integer;
    begin
        Tmp := Str'Last;
        for I in reverse Str'range loop
            exit when not Is_Space(Str(I));
            Tmp := Tmp - 1;
        end loop;
        return (Tmp);
    end Last_Non_Space;


---------------------------------  Free  --------------------------------------
--
--    Local procedure for deallocating File_Type
--
-------------------------------------------------------------------------------

    procedure Free is
        new Unchecked_Deallocation(File_Rec, File_Type);
----------------------- Initialize ----------------------------
--
--  Purpose:
--  -------
--    Internal function to allocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are allocated from heap.
--
---------------------------------------------------------------------

    procedure Initialize(Ft : in out File_Type) is
    begin
        Ft := new File_Rec;
    end Initialize;

----------------------- Deallocate ----------------------------
--
--  Purpose:
--  -------
--    Internal function to deallocate file handle.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    File_Recs are released to heap via unchecked deallocation.
--
---------------------------------------------------------------------

    procedure Deallocate(Ft : in out File_Type) is
    begin
        Free(Ft);
        null;
    end Deallocate;

----------------------- Un_Initialized ----------------------------
--
--  Purpose:
--  -------
--    Internal function to test whether file has been
--    initialized.  Returns True if not initialized,
--    otherwise returns False.
--
--  Parameters:
--  ----------
--    FT    (access to) file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Handle is checked for null reference.
--
---------------------------------------------------------------------

    function Un_Initialized(Ft : File_Type) return Boolean is
    begin
        return (Ft = null);
    end Un_Initialized;

----------------------- Assign ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to copy one file handle record to
--    another.
--
--  Parameters:
--  ----------
--    From    (access to) source file handle record.
--    To    (access to) target file handle record.
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    If the target file handle is uninitialized, Assign initializes
--    it before copying the components of the record.
--
---------------------------------------------------------------------

    procedure Assign(From : File_Type;
                     To   : in out File_Type) is
    begin
        if Un_Initialized(To) then
            Initialize(To);
        end if;
        To.Fd := From.Fd;
        To.Shadow_File_Name := From.Shadow_File_Name;
        To.Contents_File_Name := From.Contents_File_Name;
        To.Intent := From.Intent;
        To.Intent_Size := From.Intent_Size;
        To.Mode := From.Mode;
        To.Name := From.Name;
        Copy(To.Form, From.Form);
    end Assign;
-----------------------  Get_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal function to fetch (access to) the Ada file descriptor
--    for the contents file from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Direct_Io.File_Type,
--    The access value returned is of type Direct_File_Ptr.
--
---------------------------------------------------------------------

    function Get_File_Type(Ft : File_Type) return Direct_File_Ptr is
    begin
        if Un_Initialized(Ft) then
            raise Status_Error;
        end if;
        return Ft.Fd;
    end Get_File_Type;

-----------------------  Set_File_Type ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store (access to) an Ada file descriptor
--    for the contents file into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT    initialized file handle.
--    DFD    access to the Direct_Io file descriptor.
--
--  Exceptions:
--  ----------
--    Status_Error
--        raised if file handle has not been initialized.
--
--  Notes:
--  -----
--    The file descriptor is implemented as an Ada Direct_Io.File_Type.
--    The access parameter is of type Direct_File_Ptr.
--
---------------------------------------------------------------------

    procedure Set_File_Type(Ft  : in out File_Type;
                            Dfd : Direct_File_Ptr) is
    begin
        if Un_Initialized(Ft) then
            raise Status_Error;
        end if;
        Ft.Fd := Dfd;
    end Set_File_Type;

-----------------------  Get_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the shadow file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

    procedure Get_Shadow_File_Name(Ft       : File_Type;
                                   Name     : in out String;
                                   Lastchar : in out Natural) is

        Last : Natural;
    begin
        Last := Last_Non_Space(Ft.Shadow_File_Name);
        Name(1 .. Last) := Ft.Shadow_File_Name(1 .. Last);
        Lastchar := Last;
    end Get_Shadow_File_Name;

-----------------------  Set_Shadow_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the shadow file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The shadow file contains the node image for the
--    CAIS file node, and its attributes and relationships.
--
---------------------------------------------------------------------

    procedure Set_Shadow_File_Name(Ft   : in out File_Type;
                                   Name : String) is

        Lastchar : Natural;
    begin
        Lastchar := Last_Non_Space(Name);
        Ft.Shadow_File_Name := (others => ' ');
        Ft.Shadow_File_Name(1 .. Lastchar) := Name(1 .. Lastchar);
    end Set_Shadow_File_Name;

-----------------------  Get_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the name of the contents file
--    from the CAIS file handle.
--    The file name and its length are returned in parameters
--    Name and Lastchar, respectively.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

    procedure Get_Contents_File_Name(Ft       : File_Type;
                                     Name     : in out String;
                                     Lastchar : in out Natural) is

        Last : Natural;
    begin
        Last := Last_Non_Space(Ft.Contents_File_Name);
        Name(1 .. Last) := Ft.Contents_File_Name(1 .. Last);
        Lastchar := Last;
    end Get_Contents_File_Name;

-----------------------  Set_Contents_File_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the name of the contents file
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The contents file holds the actual file contents for the
--    CAIS file node.
--
---------------------------------------------------------------------

    procedure Set_Contents_File_Name(Ft   : in out File_Type;
                                     Name : String) is

        Lastchar : Natural;
    begin
        Lastchar := Last_Non_Space(Name);
        Ft.Contents_File_Name := (others => ' ');
        Ft.Contents_File_Name(1 .. Lastchar) := Name(1 .. Lastchar);
    end Set_Contents_File_Name;

-----------------------  Get_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the intention of the node handle,
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention returned is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

    procedure Get_Intent(Ft     : File_Type;
                         Intent : in out Intention) is
    begin
        Intent := Ft.Intent(1 .. Ft.Intent_Size);
    end Get_Intent;

-----------------------  Set_Intent ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the intention of the node handle,
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Intent      intention array.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The intention to be stored is the intention with which the node
--    handle was opened to the file node.  When the file handle is
--    opened via the node handle, the intention is copied to the
--    file handle.
--
---------------------------------------------------------------------

    procedure Set_Intent(Ft     : in out File_Type;
                         Intent : Intention) is
    begin
        Ft.Intent(Intent'range ) := Intent;
        Ft.Intent_Size := Intent'Last;
    end Set_Intent;

-----------------------  Get_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the file mode
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode returned is the mode with which the file handle
--    was opened.
--
---------------------------------------------------------------------

    procedure Get_Mode(Ft   : File_Type;
                       Mode : in out File_Mode) is
    begin
        Mode := Ft.Mode;
    end Get_Mode;

-----------------------  Set_Mode ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the file mode
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Mode      file mode.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The mode to be stored is the mode with which the file handle
--    is being opened (or reset).
--
---------------------------------------------------------------------

    procedure Set_Mode(Ft   : in out File_Type;
                       Mode : File_Mode) is
    begin
        Ft.Mode := Mode;
    end Set_Mode;

-----------------------  Get_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to fetch the pathname of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--    Lastchar  index of last non-blank character in Name.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname returned is the pathname from the node handle
--    through which the file handle was opened.
--
---------------------------------------------------------------------

    procedure Get_Name(Ft       : File_Type;
                       Name     : in out String;
                       Lastchar : in out Natural) is

        Last : Natural;
    begin
        Last := Last_Non_Space(Ft.Name);
        Name(1 .. Last) := Ft.Name(1 .. Last);
        Lastchar := Last;
    end Get_Name;

-----------------------  Set_Name ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure to store the pathname of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Name      name string.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    The pathname to be stored is the pathname from the node handle
--    through which the file handle is being opened.
--
---------------------------------------------------------------------

    procedure Set_Name(Ft   : in out File_Type;
                       Name : String) is

        Lastchar : Natural;
    begin
        Lastchar := Last_Non_Space(Name);
        Ft.Name := (others => ' ');
        Ft.Name(1 .. Lastchar) := Name(1 .. Lastchar);
    end Set_Name;

-----------------------  Get_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal function which returns the form list of the file node
--    from the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

    function Get_Form(Ft : File_Type) return List_Type is
    begin
        return Ft.Form;
    end Get_Form;

-----------------------  Set_Form ----------------------------
--
--  Purpose:
--  -------
--    Internal procedure which stores the form list of the file node
--    into the CAIS file handle.
--
--  Parameters:
--  ----------
--    FT      initialized file handle.
--    Form      list of form entries.
--
--
--  Exceptions:
--  ----------
--    None raised.
--
--  Notes:
--  -----
--    Conversion between form strings for external files and the
--    CAIS form is not implemented in the prototype.
--
---------------------------------------------------------------------

    procedure Set_Form(Ft   : in out File_Type;
                       Form : List_Type) is
    begin
        Copy(Ft.Form, Form);
    end Set_Form;

---------------------------------------------------------------------
end Direct_Io_Definitions;
---------------------------------------------------------------------
--::::::::::::::
--dump.a
--::::::::::::::


----------------------------------------------------------------------
--                             D U M P
--           (Separate Procedure from Package List_Utilities)
--
--          Prints the values of components internal to a list
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Wed Oct  9 13:23:55 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------       D U M P       --------------------------
--
--  Purpose:
--  -------
--    This procedure is a debugging aid.  It simply prints the text for
--    each item in a list.
--
--  Parameters:
--  ----------
--    List    The object of List_Type to be dumped.
--
--  Exceptions:
--  ----------
--    None
--
--  Notes:
--  -----
--
---------------------------------------------------------------------

separate(Cais.List_Utilities)
procedure Dump(List : in List_Type) is

    use Standard.Text_Io;

    Current : List_Type := List;
    Blank   : constant String(1 .. 15) := "               ";
    function Slength(S : String) return Natural is
    begin
        return S'Length;
    end Slength;
begin
    while Current /= null loop
        New_Line;
        Put(Item_Kind'Image(Current.Kind));
        Put(Blank(1 .. 15 - Slength(Item_Kind'Image(Current.Kind))));  --!
--! not allowed by current version of VADS:
--!    put(BLANK(1..15-Item_Kind'image(Current.Kind)'length));
--!------------------------^A                                              ###
--!--### A:error: LRM 4.1: prefix must be a name or function call

        if Current.Name /= null then
            Put(Retrieve(Current.Name));
            Put(Blank(1 .. 15 - Length(Current.Name)));
        else
            Put(Blank(1 .. 15));
        end if;

        if Current.Kind = List_Item then
            Put("*****");
            Dump(Current.List);
            Put_Line("*****END OF LIST****");
        else
            Put(Retrieve(Current.Element));
            Put(Blank(1 .. 15 - Length(Current.Element)));
        end if;

        Current := Current.Next_Item;
    end loop;
    New_Line;
end Dump;
--::::::::::::::
--file_import_export_body.a
--::::::::::::::


----------------------------------------------------------------------
--          Package  F I L E _ I M P O R T _ E X P O R T
--            (Package Body)
--
--        Operations to Transfer Files Between
--          the CAIS and Host Environments
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--             Wed Oct  9 13:33:54 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--               F I L E _ I M P O R T _ E X P O R T
--
--  Purpose:
--  -------
--        The CAIS allows a particular CAIS implementation to
--        maintain files separately from files maintained by
--        the host file system.  This package provides the
--        capability to transfer files between these two systems.
--
--  Usage:
--  -----
--        The operations contained in this package are
--        Import which transfers a file from the host file
--        system into a CAIS file node, and Export which
--        transfers the contents of a CAIS file node to a
--        host file.
--
--  Notes:
--  -----
--        This is a version of the package CAIS.FILE_IMPORT_EXPORT,
--        specified in MIL-STD-CAIS section 5.3.10; all references
--        to the CAIS specification refer to the CAIS specification
--        dated 31 January 1985.
--
--  Revision History:
--  ----------------
--        None.
--
-------------------------------------------------------------------


with Sequential_Io;

separate(Cais)
package body File_Import_Export is

    use Node_Management;
    use Node_Definitions;
    use Node_Representation;
    use Cais.Io_Definitions;

----------------------     Import     ----------------------
--
--  Purpose:
--  -------
--    This procedure searches for a file in the host file system
--    named Host_File_Name and copies its contents into a CAIS
--    file which is the contents of the node identified by Node.
--
--  Parameters:
--  ----------
--    Node        open node handle on the file node.
--    Host_File_Name    name of the host file to be copied.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if the node identified by Node is inaccessible.
--    Use_Error
--        raised if Host_File_Name noes not adhere to the
--        required syntax for file names in the host file system
--        or if Host_File_Name does not exist in the host file
--        system.
--
--        also raised if File is not the value of the attribute
--        Kind of the node identified by Node.
--    Status_Error
--        raised if Node is not an open node handle.
--    Intent_Violation
--        raised if Node was not opened with an intent establishing
--        the right to write contents.
--    Security_Violation
--        raised if the operation represents a violation of mandatory
--        access controls.  Security_Violation is raised only if the
--        conditions for other exceptions are not present.
--
--  Notes:
--  -----
--    Semantics are defined in cais_MIL-STD Section 5.3.10.1
--
---------------------------------------------------------------------

    procedure Import(Node           : in out Node_Type;
                     Host_File_Name : in String)

    is
        package Byte_Io is
            new Standard.Sequential_Io(Tiny_Integer);

        Contents_File_Name : Name_String(1 .. Pragmatics.Max_Name_String);
        Length             : Natural;
        Host_File          : Byte_Io.File_Type;
        Contents_File      : Byte_Io.File_Type;
        Byte               : Tiny_Integer;

    begin
        if not Node_Management.Is_Open(Node) then
            raise Node_Definitions.Status_Error;
        --elsif not Node_Management.Is_Obtainable(Node) then
            --raise Name_Error;
        end if;

        Get_Contents_File_Name(Node, Contents_File_Name, Length);

        Byte_Io.Open(Host_File, Byte_Io.In_File, Host_File_Name);
        Byte_Io.Open(Contents_File, Byte_Io.Out_File, Contents_File_Name(1 ..
            Length));

        begin
            loop
                Byte_Io.Read(Host_File, Byte);
                Byte_Io.Write(Contents_File, Byte);
            end loop;
        exception
            when End_Error =>
                Byte_Io.Close(Host_File);
                Byte_Io.Close(Contents_File);
            when others =>
                raise;
        end;
    exception
        -- exceptions that are trapped (nothing propagated)
        --    End_Error
        -- exceptions that are propagated
        when Cais.Io_Definitions.Name_Error | Cais.Io_Definitions.Use_Error |
            Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Mode_Error |
            Cais.Io_Definitions.Device_Error | Cais.Io_Definitions.End_Error |
            Cais.Io_Definitions.Data_Error | Cais.Io_Definitions.Layout_Error |
            Node_Definitions.Name_Error | Node_Definitions.Use_Error |
            Node_Definitions.Status_Error | Node_Definitions.Lock_Error |
            Node_Definitions.Intent_Violation | Node_Definitions.
            Access_Violation | Node_Definitions.Security_Violation =>
            raise;


        -- exceptions that are mapped to other exceptions
        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in File_Import_Export.Import ");
            raise;
        -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in File_Import_Export.Import "
                );
            raise Trace.Assertion_Violation;
    end Import;

-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

    procedure Import(Name           : in Node_Definitions.Name_String;
                     Host_File_Name : in String) is
        Node : Node_Type;
    begin
        Node_Management.Open(Node, Name, (1 => Write_Contents));
        Import(Node, Host_File_Name);
        Node_Management.Close(Node);
    exception
        when others =>
            Node_Management.Close(Node);
            raise;
    end Import;

----------------------     Export     ----------------------
--
--  Purpose:
--  -------
--    This procedure creates a new file named Host_File_Name in
--    the host file system and copies the contents of the file
--    node identified by Node into it.
--
--  Parameters:
--  ----------
--    Node        open node handle on the file node.
--    Host_File_Name    name of the host file to be created.
--
--  Exceptions:
--  ----------
--    Name_Error
--        raised if the node identified by Node is inaccessible.
--    Use_Error
--        raised if Host_File_Name noes not adhere to the
--        required syntax for file names in the host file system
--        or if Host_File_Name cannot be created in the host file
--        system.
--
--        also raised if File is not the value of the attribute
--        Kind of the node identified by Node.
--    Status_Error
--        raised if Node is not an open node handle.
--    Intent_Violation
--        raised if Node was not opened with an intent establishing
--        the right to read contents.
--
--  Notes:
--  -----
--    Semantics are defined in cais_MIL-STD Section 5.3.10.2
--
---------------------------------------------------------------------

    procedure Export(Node           : in out Node_Type;
                     Host_File_Name : in String)

    is
        package Byte_Io is
            new Standard.Sequential_Io(Tiny_Integer);

        Contents_File_Name : Name_String(1 .. Pragmatics.Max_Name_String);
        Length             : Natural;
        Host_File          : Byte_Io.File_Type;
        Contents_File      : Byte_Io.File_Type;
        Byte               : Tiny_Integer;

    begin
        if not Node_Management.Is_Open(Node) then
            raise Node_Definitions.Status_Error;
        end if;

        Get_Contents_File_Name(Node, Contents_File_Name, Length);

        Byte_Io.Create(Host_File, Byte_Io.Out_File, Host_File_Name);
        Byte_Io.Open(Contents_File, Byte_Io.In_File, Contents_File_Name(1 ..
            Length));

        begin
            loop
                Byte_Io.Read(Contents_File, Byte);
                Byte_Io.Write(Host_File, Byte);
            end loop;
        exception
            when End_Error =>
                Byte_Io.Close(Host_File);
                Byte_Io.Close(Contents_File);
            when others =>
                raise;
        end;

    exception
    -- exceptions that are trapped (nothing propagated)
    -- exceptions that are propagated
        when Cais.Io_Definitions.Name_Error | Cais.Io_Definitions.Use_Error |
            Cais.Io_Definitions.Status_Error | Cais.Io_Definitions.Mode_Error |
            Cais.Io_Definitions.Device_Error | Cais.Io_Definitions.End_Error |
            Cais.Io_Definitions.Data_Error | Cais.Io_Definitions.Layout_Error |
            Node_Definitions.Name_Error | Node_Definitions.Use_Error |
            Node_Definitions.Status_Error | Node_Definitions.Lock_Error |
            Node_Definitions.Intent_Violation | Node_Definitions.
            Access_Violation | Node_Definitions.Security_Violation =>
            raise;

    -- exceptions that are mapped to other exceptions
    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in File_Import_Export.Export ");
            raise;
    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in File_Import_Export.Export "
                );
            raise Trace.Assertion_Violation;

    end Export;

-------------------------------------------------------------------------------
--
--    Alternate interface using Name (pathname) rather than Base, Relation,
--    and Key to refer to file node.
--
-------------------------------------------------------------------------------

    procedure Export(Name           : in Node_Definitions.Name_String;
                     Host_File_Name : in String) is
        Node : Node_Type;
    begin
        Node_Management.Open(Node, Name, (1 => Read_Contents));
        Export(Node, Host_File_Name);
        Node_Management.Close(Node);
    exception
        when others =>
            Node_Management.Close(Node);
            raise;
    end Export;


-----------------------------------------------------------------------
end File_Import_Export;
-----------------------------------------------------------------------
--::::::::::::::
--form_terminal_body.a
--::::::::::::::
separate(Cais)
package body Form_Terminal is
    use Node_Definitions;
    use Io_Definitions;
    use Io_Control;

    function Maximum_Function_Key(Terminal : File_Type) return Natural is
    begin
        Trace.Assert_Fatal(False, "Maximum_Function_Key is NOT implemented");
        return 0;
    end Maximum_Function_Key;

    function Maximum_Function_Key return Natural is
    begin
        Trace.Assert_Fatal(False, "Maximum_Function_Key is NOT implemented");
        return 0;
    end Maximum_Function_Key;

    procedure Define_Qualified_Area(Form       : in out Form_Type;
                                    Intensity  : Area_Intensity := Normal;
                                    Protection : Area_Protection := Protected;
                                    Input      : Area_Input :=
                                        Graphic_Characters;
                                    Value      : Area_Value := No_Fill) is
    begin
        Trace.Assert_Fatal(False, "Define_Qualified_Area is NOT implemented");
    end Define_Qualified_Area;

    procedure Remove_Area_Qualifier(Form : in out Form_Type) is
    begin
        Trace.Assert_Fatal(False, "Remove_Area_Qualifier is NOT implemented");
    end Remove_Area_Qualifier;

    procedure Set_Position(Form     : in out Form_Type;
                           Position : Position_Type) is
    begin
        Trace.Assert_Fatal(False, "Set_Position is NOT implemented");
    end Set_Position;

    procedure Next_Qualified_Area(Form  : in out Form_Type;
                                  Count : Positive := 1) is
    begin
        Trace.Assert_Fatal(False, "Next_Qualified_Area is NOT implemented");
    end Next_Qualified_Area;

    procedure Put(Form : in out Form_Type;
                  Item : Printable_Character) is
    begin
        Trace.Assert_Fatal(False, "Put is NOT implemented");
    end Put;

    procedure Put(Form : in out Form_Type;
                  Item : String) is
    begin
        Trace.Assert_Fatal(False, "Put is NOT implemented");
    end Put;

    procedure Erase_Area(Form : in out Form_Type) is
    begin
        Trace.Assert_Fatal(False, "Erase_Area is NOT implemented");
    end Erase_Area;

    procedure Erase_Form(Form : in out Form_Type) is
    begin
        Trace.Assert_Fatal(False, "Erase_Form is NOT implemented");
    end Erase_Form;

    procedure Activate(Terminal : File_Type;
                       Form     : in out Form_Type) is
    begin
        Trace.Assert_Fatal(False, "Activate is NOT implemented");
    end Activate;

    procedure Get(Form : in out Form_Type;
                  Item : in out Printable_Character) is
    begin
        Trace.Assert_Fatal(False, "Get is NOT implemented");
    end Get;

    procedure Get(Form : in out Form_Type;
                  Item : in out String) is
    begin
        Trace.Assert_Fatal(False, "Get is NOT implemented");
    end Get;

    function Is_Form_Updated(Form : Form_Type) return Boolean is
    begin
        Trace.Assert_Fatal(False, "Is_Form_Updated is NOT implemented");
        return False;
    end Is_Form_Updated;

    function Termination_Key(Form : Form_Type) return Natural is
    begin
        Trace.Assert_Fatal(False, "Termination_Key is NOT implemented");
        return 0;
    end Termination_Key;

    function Form_Size(Form : Form_Type) return Position_Type is
    begin
        Trace.Assert_Fatal(False, "Form_Size is NOT implemented");
        return (Row => 0, Column => 0);
    end Form_Size;

    function Terminal_Size(Terminal : File_Type) return Position_Type is
    begin
        Trace.Assert_Fatal(False, "Terminal_Size is NOT implemented");
        return (Row => 0, Column => 0);
    end Terminal_Size;

    function Terminal_Size return Position_Type is
    begin
        Trace.Assert_Fatal(False, "Terminal_Size is NOT implemented");
        return (Row => 0, Column => 0);
    end Terminal_Size;

    function Area_Qualifier_Requires_Space(Form : Form_Type) return Boolean is
    begin
        Trace.Assert_Fatal(False,
            "Area_Qualifier_Requires_Space  is NOT implemented");
        return False;
    end Area_Qualifier_Requires_Space;

    function Area_Qualifier_Requires_Space(Terminal : File_Type) return Boolean
        is
    begin
        Trace.Assert_Fatal(False,
            "Area_Qualifier_Requires_Space  is NOT implemented");
        return False;
    end Area_Qualifier_Requires_Space;

    function Area_Qualifier_Requires_Space return Boolean is
    begin
        Trace.Assert_Fatal(False,
            "Area_Qualifier_Requires_Space  is NOT implemented");
        return False;
    end Area_Qualifier_Requires_Space;


end Form_Terminal;
--::::::::::::::
--generic_list.a
--::::::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : generic package LINKED_LIST
-- Version      : 1.0
-- Author       : Richard Conn
--              : Texas Instruments
--              : PO Box 801, Mail Stop 8007
--              : McKinney, TX  75069
-- DDN Address  : RCONN@SIMTEL20
-- Copyright    : (c) 1984 Richard Conn
-- Date created :  OCTOBER 2, 1984
-- Release date :  NOVEMBER 29, 1984
-- Last update  :  CONN NOVEMBER 29, 1984
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  DOUBLY-LINKED LIST
----------------:  LIST MANIPULATION
--
-- Abstract     :  This package provides a number of routines
----------------:  which can be used to manipulate a doubly-
----------------:  linked list.  See the visible section for
----------------:  a rather complete set of documentation on
----------------:  the routines.
----------------:
----------------:  Each element of the list is of the following
----------------:  structure:
----------------:     RECORD
----------------:      contents: element_object;  -- data
----------------:      next:     element_pointer; -- ptr
----------------:    previous: element_pointer; -- ptr
----------------:     END RECORD;
----------------:
--                                                           -*
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- 11/29/84       1.0    Richard Conn        Initial Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------

--
-- Generic Package to Handle Doubly-Linked Lists
--    by Richard Conn, TI Ada Technology Branch
--
-- The purpose of this package is to provide a software component
-- which can be generically instantiated to handle any type of
-- doubly-linked list.  The set of routines provided in this package
-- are general-purpose in nature and manipulate the elements of a
-- doubly-linked list without regard to their contents.  Each element
-- of the list is of the following structure:
--
--    record
--      content  : element_object;  -- the data in the list element
--      next     : element_pointer; -- pointer to the next element
--      previous : element_pointer; -- pointer to the previous element
--    end record;
--

with Unchecked_Deallocation;
generic
    type element_object is private;


package generic_list is

--
-- The following type declarations are used throughout is package
-- and are needed by the programs which WITH this package.
--

    type list_element;
    type element_pointer is access list_element;
    type list_element is
        record
            content  : element_object; -- the generic object
            next     : element_pointer;
            previous : element_pointer;
        end record;

    type Element_Rec is record             -- CCH 2 April 85
    First_Element   : Element_Pointer;
    Last_Element    : Element_Pointer;
    Current_Element : Element_Pointer;
    end record;

    type List is access Element_Rec;       -- CCH 2 April 85


--
-- The following procedures and functions initialize the list and
-- return pointers to the three list elements which are continuously
-- tracked by the routines in this package.  These list elements
-- are:
--
--    first_element       the first element in the list
--    last_element        the last element in the list
--    current_element     the current element in the list
--

    procedure initialize_list (L : out List);
    function  return_first_element (L : List)   return element_pointer;
    function  return_last_element  (L : List)   return element_pointer;
    function  return_current_element (L : List) return element_pointer;
    function  return_first_element (L : List)   return element_object;
    function  return_last_element (L : List)    return element_object;
    function  return_current_element (L : List) return element_object;

--
-- The following procedures and functions manipulate the current
-- element pointer.  The following table outlines their functions:
--
--    set_first           the first element becomes the current element
--    set_last            the last element becomes the current element
--    current_index       return the number of the current element
--                          (ordinal); 0 returned if list is empty
--    current_next        set current element to next element in the
--                          list; return TRUE if done or FALSE if
--                          already at end of list
--    current_previous    set current element to previous element in the
--                          list; return TRUE if done or FALSE if
--                          already at front of list
--    set_current_index   set the Nth element as the current element;
--                          return TRUE if done or FALSE if end of list
--                          encountered, in which case the last element
--                          becomes the current element
--

    procedure set_first (L : List);
    procedure set_last (L : List);
    function  current_index (L : List)     return natural;
    function  current_next (L : List)      return boolean;
    function  current_previous (L : List)  return boolean;
    function  set_current_index (L : List;
    index : natural) return boolean;

--
-- The following functions return the index of the last element in
-- the list and indicate if the list is empty or not.
--
--    last_index          return the number of the last element
--                          (ordinal); 0 returned if list is empty
--    list_empty          return TRUE if the list is empty; FALSE if
--                          the list is not empty
--    at_end_of_list      return TRUE if the current_element is also
--                          the last_element; return FALSE if not
--    at_front_of_list    return TRUE if the current_element is also
--                          the first_element; return FALSE if not
--

    function last_index (L : List)       return natural;
    function list_empty (L : List)       return boolean;
    function at_end_of_list (L : List)   return boolean;
    function at_front_of_list (L : List) return boolean;

--
-- The following procedures and functions are used to manipulate
-- the elements in the list.
--
--    append_element       append the indicated element after the
--                           current_element in the list; the
--                           current_element is set to the new
--                           element
--    insert_element       insert the indicated element before the
--                           current_element in the list; the
--                           current_element is unchanged
--    delete_element       delete the current_element from the list;
--                           the next element is the new current_element
--                           unless there is no next element, in which
--                           case the previous element is the new
--                           current_element
--

    procedure append_element (L : List;
    element : element_pointer);
    procedure append_element (L : List;
    element : element_object);
    procedure insert_element (L : List;
    element : element_pointer);
    procedure insert_element (L : List;
    element : element_object);
    procedure delete_element (L : List);

--
-- The following function and procedure are used to dynamically
-- create new elements and to free the space occupied by unneeded
-- elements.
--
--    new_element        returns a pointer to a new list_element
--    free_element       frees the indicated list_element
--

    function  new_element  return element_pointer;
 procedure free_element is new unchecked_deallocation
    (list_element, element_pointer);

end generic_list;


--
-- BODY of generic_list
--
package body generic_list is

--
-- Definition of the three element pointers
--

--
-- Procedure to initialize the list
--    All element pointers are initialized to null
--
    procedure initialize_list (L : out List) is
    begin
    L := new Element_Rec;
    end initialize_list;

--
-- Functions to return element pointers
--
    function return_first_element (L : List) return element_pointer is
    begin
        return L.first_element;
    end return_first_element;

    function return_first_element (L : List) return element_object is
    begin
        return L.first_element.content;
    end return_first_element;

    function return_last_element (L : List) return element_pointer is
    begin
        return L.last_element;
    end return_last_element;

    function return_last_element (L : List) return element_object is
    begin
        return L.last_element.content;
    end return_last_element;

    function return_current_element (L : List) return element_pointer is
    begin
        return L.current_element;
    end return_current_element;

    function return_current_element (L : List) return element_object is
    begin
        return L.current_element.content;
    end return_current_element;

--
-- Current element pointer manipulation
--
    procedure set_first (L : List) is
    begin
        L.current_element := L.first_element;
    end set_first;

    procedure set_last (L : List) is
    begin
        L.current_element := L.last_element;
    end set_last;

    function current_index (L : List) return natural is
        local_element : element_pointer;
        index         : natural;
    begin
        index := 0; -- initialize counter and set empty list return
        if L.current_element /= null then
            local_element := L.first_element; -- point to first element
            index := 1;
            while local_element /= L.current_element loop
                exit when local_element = null; -- error trap
                local_element := local_element.next;
                index := index + 1;
            end loop;
        end if;
        return index;
    end current_index;

    function current_next (L : List) return boolean is
    begin
        if L.current_element = L.last_element then
            return FALSE;
        else
            L.current_element := L.current_element.next;
            return TRUE;
        end if;
    end current_next;

    function current_previous (L : List) return boolean is
    begin
        if L.current_element = L.first_element then
            return FALSE;
        else
            L.current_element := L.current_element.previous;
            return TRUE;
        end if;
    end current_previous;

    function  set_current_index (L : List;
    index : natural) return boolean is
    begin
        L.current_element := L.first_element; -- start at first element
        if index <= 1 then
            return TRUE;
        else
            for counter in 1 .. index - 1 loop
                if L.current_element = L.last_element then
                    return FALSE;
                    exit;      -- this exit may not be necessary
                else
                    L.current_element := L.current_element.next;
                end if;
            end loop;
            return TRUE;
        end if;
    end set_current_index;

--
-- Return the index of the last element in the list
--
    function last_index (L : List) return natural is
        current_save : element_pointer;
        index        : natural;
    begin
        current_save := L.current_element;
        L.current_element := L.last_element;
        index := current_index(L);
        L.current_element := current_save;
        return index;
    end last_index;

--
-- Determine if the list is empty; return TRUE if so, FALSE if not
--
    function list_empty (L : List) return boolean is
    begin
        if L.first_element = null then
            return TRUE; -- list is empty
        else
            return FALSE; -- list is not empty
        end if;
    end list_empty;

--
-- Determine if at first element in list; return TRUE if so
--
    function at_front_of_list (L : List) return boolean is
    begin
        if L.current_element = L.first_element then
            return TRUE;
        else
            return FALSE;
        end if;
    end at_front_of_list;

--
-- Determine if at last element in list; return TRUE if so
--
    function at_end_of_list (L : List) return boolean is
    begin
        if L.current_element = L.last_element then
            return TRUE;
        else
            return FALSE;
        end if;
    end at_end_of_list;

--
-- Procedures to manipulate elements in list
--  These procedures insert elements into the list and
--  delete elements from the list
--
    procedure append_element (L : List;
    element : element_pointer) is
    begin
        if list_empty (L) then
            L.first_element := element;
            L.last_element := element;
            L.current_element := element;
            element.next := null;
            element.previous := null;
        else
            element.next := L.current_element.next;
            L.current_element.next := element;
            element.previous := L.current_element;
            if element.next /= null then
                element.next.previous := element;
            else
                L.last_element := element;
            end if;
        end if;
        L.current_element := element;
    end append_element;

    procedure append_element (L : List;
    element : element_object) is

        loc_element : element_pointer;
    begin
        loc_element := new_element;
        loc_element.content := element;
        append_element (L, loc_element);
    end append_element;

    procedure insert_element (L : List;
    element : element_pointer) is
    begin
        if list_empty (L) then
            L.first_element := element;
            L.last_element := element;
            L.current_element := element;
            element.next := null;
            element.previous := null;
        else
            element.previous := L.current_element.previous;
            L.current_element.previous := element;
            element.next := L.current_element;
            if element.previous /= null then
                element.previous.next := element;
            else
                L.first_element := element;
            end if;
        end if;
    end insert_element;

    procedure insert_element (L: List;
    element : element_object) is

        loc_element : element_pointer;
    begin
        loc_element := new_element;
        loc_element.content := element;
        insert_element (L, loc_element);
    end insert_element;

    procedure delete_element (L : List) is
        temp_element : element_pointer;
    begin
        if not list_empty (L) then

            if L.current_element = L.first_element then
                L.first_element := L.current_element.next;
            else
                L.current_element.previous.next := L.current_element.next;
            end if;

            if L.current_element = L.last_element then
                L.last_element := L.current_element.previous;
                temp_element := L.last_element;
            else
                L.current_element.next.previous := L.current_element.previous;
                temp_element := L.current_element.next;
            end if;

            free_element (L.current_element);
            L.current_element := temp_element;
        end if;
    end delete_element;

--
-- Memory management routines
--   Obtain a new list element and free old, unneeded list elements
--
    function new_element return element_pointer is
    begin
        return (new list_element);
    end new_element;

    -- procedure free_element (element : element_pointer) is
--
-- This procedure is a dummy for now; the following generic
-- instantiation is what it should be, but there is a bug in my
-- Ada compiler which prevents this instatiation from working
--

    -- begin
        -- null;
    -- end free_element;

end generic_list;

--::::::::::::::
--generic_stack.a
--::::::::::::::

----------------------------------------------------------------------
--                          GENERIC_STACK
--               (Generic Package Specification and Body)
--
--
--             Generic Package for Simple Stack Services
--
--
--                           Chuck Howell
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Mon Apr  1 12:32:16 EST 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

----------------------------------------------------------------------
--
--  Purpose:
--  -------
--
--  Usage:
--  -----
--
--  Example:
--  -------
--
--  Notes:
--  -----
--    Changed type Node to type Stack_Record, and removed superflous
--    else statements in Pop and Top.
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------

generic
    type Item is private;
package Generic_Stack is

    type Stack is private;

    procedure Push (
    L : in out Stack;
    I : Item);

    procedure Pop (
    L : in out Stack);

    function Top (
    L : Stack )
    return Item;

    function Stack_Count (
    L : Stack)
    return Natural;

    UNDERFLOW : exception;

private
    type Stack_Record;
    type Stack is access Stack_Record;
    type Stack_Record is record
    Head : Item;
    Tail : Stack;
    end record;
end Generic_Stack;


package body Generic_Stack is

    Count : Natural := 0;

    procedure Push (
    L : in out Stack;
    I : Item) is
    begin
    L := new Stack_Record'(Head=> I, Tail=> L);
    Count := Count + 1;
    end Push;

    procedure Pop (
    L : in out Stack) is
    begin
    if L = null then
        raise UNDERFLOW;
    end if;
    Count := Count - 1;
    L := L.Tail;
    end Pop;

    function Top (
    L : Stack )
    return Item is
    begin
    if L = null then
        raise UNDERFLOW;
    end if;
    return L.Head;
    end Top;

    function Stack_Count (
    L : Stack)
    return Natural is
    begin
    return Count;
    end Stack_Count;

end Generic_Stack;
--::::::::::::::
--get_identifier.a
--::::::::::::::

----------------------------------------------------------------------
--                     G E T _ I D E N T I F I E R
--
--           Separate subprogram in package Node_Internals
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Thu Apr 11 17:27:08 EST 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

----------------------  G E T _ I D E N T I F I E R -----------------
--
--  Purpose:
--  -------
--    This procedure is a simple "lexer" service; it returns the next
--    lexical unit in the given pathname, and determines the token class.
--
--  Parameters:
--  ----------
--    Path  - the pathname from which the next lexical unit is to be
--            extracted.
--    Id    - the token that was extracted.
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.Internal_Error - any exception raised
--        during execution here is an internal error.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------

separate(Cais.Node_Internals)
procedure Get_Identifier(Path : in out Pathname;
                         Id   : in out Token) is

    Tok_Len : Positive := 1;

begin
    for I in Path.Index + 1 .. Path.Size loop
        case Path.Str_Buf(I) is
            when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' =>
                Tok_Len := Tok_Len + 1;
            when '_' =>
                if I = Path.Size then  -- can't end on _
                    Id.Class := Other;
                    return;
                end if;
                case Path.Str_Buf(I + 1) is
                    when 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' =>
                        Tok_Len := Tok_Len + 1;
                    when others =>
                        Id.Class := Other;
                        return;
                end case;
            when '(' | ')' | ':' | '#' | ''' | '.' =>
                exit;
            when others =>
                Id.Class := Other;
                return;
        end case;
    end loop;

    Id.Class := Identifier;
    To_Upper(Path.Str_Buf(Path.Index .. Path.Index + (Tok_Len - 1)));
    Id.Value(1 .. Tok_Len) := Path.Str_Buf(Path.Index .. Path.Index + (Tok_Len -
                  1));
    Id.Last_Char := Tok_Len;
    Path.Index := Path.Index + Tok_Len;

exception
    when others =>
        Trace.Report("Unhandled exception in Get_Identifier");
        raise Trace.Assertion_Violation;
end Get_Identifier;
--::::::::::::::
--get_next_token.a
--::::::::::::::

----------------------------------------------------------------------
--                     G E T _ N E X T _ T O K E N
--
--
--           Separate subprogram in package Node_Internals
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Thu Apr 11 17:27:08 EST 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

----------------------  G E T _ N E X T _ T O K E N -----------------
--
--  Purpose:
--  -------
--    This procedure extracts the next token from the given pathname.
--
--  Parameters:
--  ----------
--    From  - the pathname analyzed.
--    Next  - the token returned.
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.Internal_Error  - any exception raised
--         here indicates an error in the implementation.
--
--  Notes:
--  -----
--    None.
--
---------------------------------------------------------------------
separate(Cais.Node_Internals)
procedure Get_Next_Token(From : in out Pathname;
                         Next : in out Token) is
begin

    -- "Reset" The output token
    Next.Value := (others => ' ');
    Next.Last_Char := 1;

    if From.Index > From.Size then
        Next.Class := End_Of_Pathname;
        return;
    end if;

    case From.Str_Buf(From.Index) is
        when '(' =>
            Next.Class := Left_Paren;
            Next.Value(1) := '(';
            From.Index := From.Index + 1;
        when ')' =>
            Next.Class := Right_Paren;
            Next.Value(1) := ')';
            From.Index := From.Index + 1;
        when ':' =>
            Next.Class := Colon;
            Next.Value(1) := ':';
            From.Index := From.Index + 1;
        when '#' =>
            Next.Class := Sharp;
            Next.Value(1) := '#';
            From.Index := From.Index + 1;
        when ''' =>
            Next.Class := Tic;
            Next.Value(1) := ''';
            From.Index := From.Index + 1;
        when '.' =>
            Next.Class := Dot;
            Next.Value(1) := '.';
            From.Index := From.Index + 1;
        when 'A' .. 'Z' | 'a' .. 'z' =>
            Get_Identifier(From, Next);
        when ' ' | Ascii.Ht =>
            Skip_Whitespace(From);
            if From.Index <= From.Size then
                Next.Class := Other;
            else
                Next.Class := End_Of_Pathname;
            end if;
        when others =>
            Next.Class := Other;
    end case;

exception
    when others =>
        Trace.Report("Unhandled exception in Get_Next_Token");
        raise Trace.Assertion_Violation;
end Get_Next_Token;
--::::::::::::::
--get_parsed_pn.a
--::::::::::::::

----------------------------------------------------------------------
--                     G E T _ P A R S E D _ P N
--
--
--           Separate subprogram in package Node_Internals
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Tue May 14 13:13:27 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

----------------------  G E T _ P A R S E D _ P N  ------------------
--
--  Purpose:
--  -------
--    Given a name string, this procedure will "parse"it into the
--    consituent CAIS pathname components.
--
--  Parameters:
--  ----------
--    Name    - the string to be parsed
--    Result  - the fully parsed components.
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.Pathname_Syntax_Error  - if the supplied
--       string is not a syntactically valid pathname.
--    Cais_Internals_Exceptions.Internal_Error  - if the parse stack
--      becomes garbled.
--
--  Notes:
--  -----
--    None.
--
---------------------------------------------------------------------

separate(Cais.Node_Internals)
procedure Get_Parsed_Pn(Name   : Node_Definitions.Name_String;
                        Result : in out Parsed_Pn) is

    use Node_Representation.Pn_Comp_List;

    Parse_Stack    : Symbol_Stack.Stack;
    Path           : Pathname(Name'Length);
    Latest_Token   : Token;
    Tmp_Pn_Rec     : Pn_Rec;
    Current_Symbol : Parse_Symbol;


    procedure Reset_Pn_Rec(Rec : in out Pn_Rec) is
    begin
        Rec.Rel_Name := (others => ' ');
        Rec.Rel_Key := (others => ' ');
        Rec.Latest_Key := False;
    end Reset_Pn_Rec;

begin
    Initialize_List(Result.L);
    Path := Convert_To_Pn(Name);

    Get_Next_Token(Path, Latest_Token);
    case Latest_Token.Class is    -- Much better diagnostics needed
        when Tic =>
            Push(Parse_Stack, Element_Set);
        when Colon =>  -- must be only pathname element
            Tmp_Pn_Rec.Rel_Name := Latest_Token.Value;
            Get_Next_Token(Path, Latest_Token);
            if Latest_Token.Class /= End_Of_Pathname then
                raise Pathname_Syntax_Error;
            else
                Append_Element(Result.L, Tmp_Pn_Rec);
                return;
            end if;
        when Sharp =>
            Tmp_Pn_Rec.Rel_Name(1 .. 12) := "CURRENT_NODE";
            Tmp_Pn_Rec.Latest_Key := False;
            Append_Element(Result.L, Tmp_Pn_Rec);
            Reset_Pn_Rec(Tmp_Pn_Rec);
            Tmp_Pn_Rec.Rel_Name(1 .. 3) := "DOT";
            Tmp_Pn_Rec.Latest_Key := True;
            Append_Element(Result.L, Tmp_Pn_Rec);
            Reset_Pn_Rec(Tmp_Pn_Rec);
            Push(Parse_Stack, Element_Set);
            Get_Next_Token(Path, Latest_Token);
        when Identifier =>
            Tmp_Pn_Rec.Rel_Name(1 .. 12) := "CURRENT_NODE";
            Tmp_Pn_Rec.Latest_Key := False;
            Append_Element(Result.L, Tmp_Pn_Rec);
            Reset_Pn_Rec(Tmp_Pn_Rec);
            Tmp_Pn_Rec.Rel_Name(1 .. 3) := "DOT";
            Tmp_Pn_Rec.Rel_Key := Latest_Token.Value;
            Get_Next_Token(Path, Latest_Token);
            if Latest_Token.Class = Sharp then
                Tmp_Pn_Rec.Latest_Key := True;
                Get_Next_Token(Path, Latest_Token);
            end if;
            Push(Parse_Stack, Element_Set);
            Append_Element(Result.L, Tmp_Pn_Rec);
            Reset_Pn_Rec(Tmp_Pn_Rec);
        when Dot =>
            Tmp_Pn_Rec.Rel_Name(1 .. 3) := "DOT";
            Get_Next_Token(Path, Latest_Token);
            Push(Parse_Stack, Relationship_Key);
            Push(Parse_Stack, Element_Set);
        when Left_Paren | Right_Paren | End_Of_Pathname | Other =>
            raise Pathname_Syntax_Error;
    end case;

    loop
        Current_Symbol := Top(Parse_Stack);
        case Current_Symbol is
            when Relationship_Key =>
                if Latest_Token.Class = Sharp then
                    Tmp_Pn_Rec.Latest_Key := True;
                    Append_Element(Result.L, Tmp_Pn_Rec);
                    Reset_Pn_Rec(Tmp_Pn_Rec);
                    Get_Next_Token(Path, Latest_Token);
                    Pop(Parse_Stack);
                elsif Latest_Token.Class = Identifier then
                    Tmp_Pn_Rec.Rel_Key := Latest_Token.Value;
                    Get_Next_Token(Path, Latest_Token);
                    if Latest_Token.Class = Sharp then
                        Tmp_Pn_Rec.Latest_Key := True;
                        Get_Next_Token(Path, Latest_Token);
                    end if;
                    Append_Element(Result.L, Tmp_Pn_Rec);
                    Reset_Pn_Rec(Tmp_Pn_Rec);
                    Pop(Parse_Stack);
                else
                    if Tmp_Pn_Rec.Rel_Name(1 .. 4) = "DOT " then
                        raise Pathname_Syntax_Error;
                    end if;
                    Append_Element(Result.L, Tmp_Pn_Rec);
                    Reset_Pn_Rec(Tmp_Pn_Rec);
                    Pop(Parse_Stack);
                end if; -- Latest_Token.Class = SHARP then
            when Element_Set =>
                if Latest_Token.Class = End_Of_Pathname then
                    exit; -- done parsing
                elsif Latest_Token.Class = Tic then
                    Get_Next_Token(Path, Latest_Token);
                    if Latest_Token.Class /= Identifier then
                        raise Pathname_Syntax_Error;
                    end if;
                    Tmp_Pn_Rec.Rel_Name := Latest_Token.Value;
                    Get_Next_Token(Path, Latest_Token);
                    Push(Parse_Stack, Paren_Relationship_Key);
                elsif Latest_Token.Class = Dot then
                    Tmp_Pn_Rec.Rel_Name(1 .. 3) := "DOT";
                    Push(Parse_Stack, Relationship_Key);
                    Get_Next_Token(Path, Latest_Token);
                else
                    raise Pathname_Syntax_Error;
                end if; -- Latest_Token.Class = END_OF_PATHNAME then
            when Relation_Name =>
                if Latest_Token.Class /= Identifier then
                    raise Pathname_Syntax_Error;
                end if;
                Tmp_Pn_Rec.Rel_Name := Latest_Token.Value;
                Get_Next_Token(Path, Latest_Token);
                Pop(Parse_Stack);
            when Paren_Relationship_Key =>
                if Latest_Token.Class /= Left_Paren then
                -- assume there is no ( Relationship_key )
                    Pop(Parse_Stack);
                    Append_Element(Result.L, Tmp_Pn_Rec);
                    Reset_Pn_Rec(Tmp_Pn_Rec);
                else  -- Latest_Token.Class = LEFT_PAREN
                    Pop(Parse_Stack);
                    Get_Next_Token(Path, Latest_Token);
                    Push(Parse_Stack, Right_Paren);
                    Push(Parse_Stack, Relationship_Key);
                end if; -- Latest_Token.Class /= LEFT_PAREN then
            when Right_Paren =>
                if Latest_Token.Class /= Right_Paren then
                    raise Pathname_Syntax_Error;
                end if;
                Pop(Parse_Stack);
                Get_Next_Token(Path, Latest_Token);
            when others =>
                Trace.Report("Pathname Parser: Internal Error");
                Trace.Report("Top of Parse_Stack:" & Parse_Symbol'Image(
                    Current_Symbol));
                raise Trace.Assertion_Violation;
        end case;
    end loop;

end Get_Parsed_Pn;
--::::::::::::::
--get_unique_filename.a
--::::::::::::::

----------------------------------------------------------------------
--                 G E T _ U N I Q U E _ F I L E N A M E
--
--             Separate Subprogram in Cais_Host_Dependent
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Thu Mar 06 06:09:19 EST 1986
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
-----------------  G E T _ U N I Q U E _ F I L E N A M E -------------
--
--  Purpose:
--  -------
--    This routine is used generate a filename that is unique for the
--    CAIS "Host Directory" (the shadowdir directory).  The
--    name of the shadowdir directory (Cais_Host_Dependent.Cais_Host_Directory)
--    is used as part of a template passed to create_uniq.
--    The filename returned is fully qualified.  The new file is
--    given a file protection mask of 777 (i.e. rwxrwxrwx).
--
--  Parameters:
--  ----------
--    Name   -  name of new file
--    Length - number of significant characters in Name
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.Internal_Error - if create_uniq fails
--
--  Notes:
--  -----
--
---------------------------------------------------------------------

with System;

separate(Cais.Cais_Host_Dependent)
procedure Get_Unique_Filename(Name   : in out String;
                              Length : in out Natural) is


    Result : Integer;
    Template : constant String := ".CAISXXXXXX";
    function Create_Uniq (Name : System.Address) return Integer;
    pragma Interface (C, Create_Uniq);

begin
    Length := Cais_Host_Directory'length + Template'length;
    declare
    Tmp_Name : String (1 .. Length);
    begin
    Tmp_Name := Cais_Host_Directory & Template;
    Result := Create_Uniq (Tmp_Name'address);
    if Result = -1 then
        Trace.Report ("Get_Unique_Filename: create_uniq failed");
        raise Trace.Assertion_Violation;
    end if;
    Name (1 .. Length) := Tmp_Name;
    end;
end Get_Unique_Filename;
--::::::::::::::
--get_user_prefix.a
--::::::::::::::

----------------------------------------------------------------------
--                    G E T _ U S E R _ P R E F I X
--             (separate subprogram in CAIS_Host_Dependant)
--
--
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Mon Jun 17 07:51:04 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

-----------------  G E T _ U S E R _ P R E F I X  -------------------
--
--  Purpose:
--  -------
--    Given a particular CAIS user id, this subprogram returns the
--    fully qualified host filename for the "user prefix"; this is
--    the prefix to be added to all references to host files (shadow
--    files) specific to that user.
--
--  Parameters:
--  ----------
--    Userid   - string that is the specified CAIS user.
--
--  Exceptions:
--  ----------
--     Cais_Internals_Exceptions.No_Such_User - if the specified
--         user is not in the system node.
--
--  Notes:
--  -----
--    None.
--
---------------------------------------------------------------------
with Character_Set; use Character_Set;


separate(Cais.Cais_Host_Dependent)
function Get_User_Prefix(Userid : String) return String is

    use Node_Definitions;
    use Node_Representation;
    use List_Utilities;
    use Pragmatics;
    use Cais_Internals_Exceptions;
    use Node_Internals;
    use Cais_Utilities;


    System_Node : Node_Type;
    User_List   : List_Type;
    Prefix      : String(1 .. Max_User_Prefix_Length) := (others => ' ');
    Attributes  : List_Type;
    Tmp_List    : List_Type;
    Is_Primary  : Boolean;
    Shadow_File : String(1 .. Max_Shadow_File_Length);

begin
    Set_Shadow_File_Name(System_Node, Cais_System_Node);
    Read_Shadow_File(System_Node);
    Get_A_Relationship(Node => System_Node, Rel_Name => "User", Rel_Key =>
        Userid, Rel_Attributes => Attributes, Primary => Is_Primary, Shadow_File
        => Shadow_File);

    Extract(List => Attributes, List_Item => Tmp_List, Named => "User_Prefix");
    Simple_List_To_String(Tmp_List, Prefix);
    return Prefix(1 .. Last_Non_Space(Prefix));

exception

    when No_Such_Relationship =>
        raise No_Such_User;

end Get_User_Prefix;
--::::::::::::::
--get_userid.a
--::::::::::::::

----------------------------------------------------------------------
--                        G E T _ U S E R I D
--
--
--               Separate subprogram in package Cais_Host_Dependent
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Mon Jul  8 22:28:05 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

-------------------     G E T _ U S E R I D       --------------------
--
--  Purpose:
--  -------
--    This routine determines the CAIS userid for the calling process.
--
--  Parameters:
--  ----------
--    None (returns a string representing the userid).
--
--  Exceptions:
--  ----------
--    Cais_Internals_Exceptions.Cais_Userid_Undefined  if the current
--       process (user) does not have a CAIS userid defined.
--
--  Notes:
--  -----
--    In this Unix implementation, the userid is defined by setting
--    an environment variable.
--    For example, in the user's .login, a "setenv CAIS_USERID howell"
--    for the particular user.
--
---------------------------------------------------------------------
with System;
with Character_Set;
separate(Cais.Cais_Host_Dependent)
function Get_Userid return String is

    use Cais_Internals_Exceptions;

    My_Name : String(1 .. Pragmatics.Max_Userid_Length) := (others => ' ');
    procedure Cget_Userid(Name : System.Address);
    pragma Interface(C, Cget_Userid);

begin

    Cget_Userid(My_Name'Address);
    if My_Name(1) /= '!' then
        return My_Name(1 .. Character_Set.Last_Non_Space(My_Name));
    else
        raise Cais_Userid_Undefined;
    end if;

end Get_Userid;
--::::::::::::::
--identifier_items.a
--::::::::::::::

----------------------------------------------------------------------
--                 I D E N T I F I E R _ I T E M S
--            Separate Package Body from List_Utilities
--
--             Operations for identifiers within Lists
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Wed Oct  9 13:35:49 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--                 I D E N T I F I E R _ I T E M S
--
--  Purpose:
--  -------
--    This package provides Extract, Replace, Insert, and Position_By_Value
--    operations on identifier items within lists.  It also provides To_Text,
--    To_Token, and Is_equal operations for manipulating identifiers directly.
--
--  Usage:
--  -----
--    Tokens must conform to Ada syntax rules for names.  Upper and lower
--    case is not significant within a Token.  They are used as names
--    in named lists.  In CAIS, they are used for relations, keys, and
--    attribute names.
--
--  Example:
--  -------
--            To_Token("Ada_Name", Token);
--            Insert(Some_List,Token,5);
--            Insert(Some_List,"Name_of_Token",Token,3);
--
--  Notes: MIL_STD CAIS 5.4.1.20
--  -----
--    The package name was changed to identifier_Items so as not to conflict
--    with the enumeral Identifier_Items.
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------
separate(Cais.List_Utilities)
package body Identifier_Items is
---------------------T O _ T O K E N----------------------------
--
-- Purpose:
-- -------
--     Converts the string representation of an identifier into
--     the corresponding internal token representation.
--
-- Parameters:
-- ----------
--     Identifier is the character string to be converted to token format
--     Token      is validated token format of the Identifier
--
-- Exceptions:
-- ----------
--     Use_Error    indicates the identifier violates Ada syntax rules
--
-- Notes: MIL_STD CAIS 5.4.1.20.1
-- -----
--
-------------------------------------------------------------------
    procedure To_Token(Identifier : in Namestring;
                       Token      : in out Token_Type) is
    begin
        Validate_Item(Identifier, Identifier_Item, Token);
    end To_Token;
---------------------T O _ T E X T------------------------------
--
-- Purpose:
-- -------
--     Returns the external representation of the value of the List_Item
--     paramater.  The external representation is the identifier in
--     upper case letters adhering to Ada syntax for identifiers.
--
-- Parameters:
-- ----------
--     List_Item is a token containing an Identifier to be changed to a string
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.20.2
-- -----
--
-------------------------------------------------------------------
    function To_Text(List_Item : in Token_Type) return Namestring is
    begin
        return Retrieve(List_Item);
    end To_Text;
---------------------I S _ E Q U A L----------------------------------
--
-- Purpose:
-- -------
--     Returns true if the two token represent Ada identifiers
--     whose string representation is equal under string comparison
--     excepting diffed of two tokens being compared
--
-- Parameters:
-- ----------
--    Token1 is the 1st token to be compared
--    Token2 is the 2nd token to be compared
--    return TRUE if tokens match independent of case
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.20.4
-- -----
--
-------------------------------------------------------------------
    function Is_Equal(Token1 : in Token_Type;
                      Token2 : in Token_Type) return Boolean is
    begin
        return V_String.Is_Equal(Token1, Token2);
    end Is_Equal;
---------------------E X T R A C T----IDENTIFIER--POSITIONAL--------
--
-- Purpose:
-- -------
--     Returns the Identifier item from the nth position of the list without
--     removing it.  Use_Error indicates unsuccessful extraction.
--
-- Parameters:
-- ----------
--     List       is the unnamed list of interest
--     Position   is the position o-
-- Exceptions:
-- ----------
--     Use_Error        indicates an empty or named list or that
--            position exceeds the length of the list
--
-- Notes: MIL_STD CAIS 5.4.1.20.4
-- -----
--
-------------------------------------------------------------------

    procedure Extract(List     : in List_Type;
                      Position : in Position_Count;
                      Token    : in out Token_Type) is
        Current : List_Type;      --ptr to named item
    begin
        if List = null then
            raise Use_Error;
        else
            Find(List, Position, Current);
            if Current.Kind /= Identifier_Item then
                raise Use_Error;
            else
                Copy(Token, Current.Element);
            end if;
        end if;
    end Extract;
---------------------E X T R A C T----IDENTIFIER--NAME--------------
--
-- Purpose:
-- -------
--     Returns the named identifier item from the list without removing it.
--     Use_Error and Search_Error indicate unsuccessful extraction.
--
-- Parameters:
-- ----------
--     List       is the unnamed list of interest
--     Name       is the Name of the identifier to be extracted
--     Token      is the value of the selected identifier in token format
--
-- Exceptions:
-- ----------
--     Search_error     indicates Named item not found
--     Use_Error        indicates an empty or positional list
--
-- Notes: MIL_STD CAIS 5.4.1.20.4
-- -----
--
-------------------------------------------------------------------

    procedure Extract(List  : in List_Type;
                      Named : in Namestring;
                      Token : in out Token_Type) is
        Current : List_Type;      --ptr too named item
    begin
        if List = null then
            raise Use_Error;
        else
            Find(List, Named, Current);
            if Current.Kind /= Identifier_Item then
                raise Use_Error;
            else
                Copy(Token, Current.Element);
            end if;
        end if;
    end Extract;
---------------------E X T R A C T----IDENTIFIER--NAME-TOKEN--------
--
-- Purpose:
-- -------
--     Returns the named identifier item from the list without removing it.
--     Use_Error and Search_Error indicate unsuccessful extraction.
--
-- Parameters:
-- ----------
--     List       is the unnamed list of interest
--     Name       is the Name (in token form) of the identifier to be extracted
--     Token      is the value of the selected identifier in token format
--
-- Exceptions:
-- ----------
--     Search_error     indicates Named item not found
--     Use_Error        indicates an empty or positional list
--
-- Notes: MIL_STD CAIS 5.4.1.20.4
-- -----
--
-------------------------------------------------------------------

    procedure Extract(List  : in List_Type;
                      Named : in Token_Type;
                      Token : in out Token_Type) is
        Current : List_Type;      --ptr to named item
    begin
        Extract(List, Retrieve(Named), Token);
    end Extract;
--------------------R E P L A C E--IDENTIFIER---POSITIONAL--------------
--
-- Purpose:
-- -------
--     Replaces an identifier item in a positional list.  The new item
--     must be of the same item kind as the one being replaced.
--
-- Parameters:
-- ----------
--     List       is the unnamed list of interest
--     List_Item  is the replacement value for an identifier item
--     Position   is the position of the identifier in list to be replaced
--
-- Exceptions:
-- ----------
--     Use_Error        is raised if item kinds do not match,
--                      or if position exceeds list length.
--
-- Notes:  MIL_STD CAIS 5.4.1.20.5
-- -----
--
----------------------------------------------------------------

    procedure Replace(List      : in out List_Type;
                      List_Item : in Token_Type;
                      Position  : in Position_Count) is
        Current : List_Type;   --ptr to list element being modified
    begin
        Find(List, Position, Current);
        if Current.Kind = Identifier_Item then
            Validate_Item(Retrieve(List_Item), Identifier_Item, Current.Element)
                ;
        else
            raise Use_Error;
        end if;
    end Replace;
--------------------R E P L A C E--IDENTIFIER---NAMED------------------
--
-- Purpose:
-- -------
--     Replaces an item in a named list.  The new item
--     must be of the same item kind as the one being replaced.
--
-- Parameters:
-- ----------
--     List       is the named list of interest
--     List_Item  is the replacement value for an identifier_item in list
--     Named      is the name of an identifier in list which will be replaced
--
-- Exceptions:
-- ----------
--     Use_Error        is raised if item kinds do not match.
--     Search_Error     is raised if Named item is not found.
--
-- Notes:  MIL_STD CAIS 5.4.1.20.5
-- -----
--
----------------------------------------------------------------

    procedure Replace(List      : in out List_Type;
                      List_Item : in Token_Type;
                      Named     : in Namestring) is
        Current : List_Type;       --ptr to list element being modified
    begin
        Find(List, Named, Current);
        if Current.Kind = Identifier_Item then --enumeration
            Validate_Item(Retrieve(List_Item), Identifier_Item, Current.Element)
                ;
        else
            raise Use_Error;
        end if;
    end Replace;
--------------------R E P L A C E--IDENTIFIER---NAMED--TOKEN----------------
--
-- Purpose:
-- -------
--     Replaces an identifier item in a named list.  The new item
--     must be of the same item kind as the one being replaced.
--
-- Parameters:
-- ----------
--     List       is the named list of interest
--     List_Item  is the replacement value for an identifier in List
--     Named      is the name (in token format) of an identifier in List which
--                will be replaced
--
-- Exceptions:
-- ----------
--     Use_Error        is raised if item kinds do not match.
--     Search_Error     is raised if Named item is not found.
--
-- Notes:  MIL_STD CAIS 5.4.1.20.5
-- -----
--
----------------------------------------------------------------

    procedure Replace(List      : in out List_Type;
                      List_Item : in Token_Type;
                      Named     : in Token_Type) is
    begin
        Replace(List, List_Item, Retrieve(Named));
    end Replace;
-----------------I N S E R T--IDENTIFIER--POSITIONAL-----------------
--
-- Purpose:
-- -------
--     Inserts an identifier item into a positional list.  Use_Error
--     or Search_Error may be raised indicating identifier item has
--     not been inserted.
--
-- Parameters:
-- ----------
--     List       is the named list of interest
--     List_Item  is the replacement value for an identifier in List
--     Position   is the position of the item after which the Identifier is
--                inserted
-- Exceptions:
-- ----------
--     Use_Error     is raised if this is a named list,
--                   or if position exceeds size of list
--
-- Notes: MIL_STD CAIS 5.4.1.20.6
-- -----
--
----------------------------------------------------------------

    procedure Insert(List      : in out List_Type;
                     List_Item : in Token_Type;
                     Position  : in Count) is
        Current  : List_Type;       --ptr to list item to insert after
        New_Item : List_Type;       --ptr to area where new list item is built

    begin
        if Position /= 0 then
            Find(List, Position, Current);
        elsif List /= null and then List.Name /= null then
            raise Use_Error;            --Mixed Named/Positional Items
        end if;
        New_Item := new Item_Descriptor;
        Validate_Item(Retrieve(List_Item), Identifier_Item, New_Item.Element);

        --store value fields
        New_Item.Name := null;
        New_Item.Kind := Identifier_Item;

    end Insert;
-----------------I N S E R T--IDENTIFIER--NAMED----------------------
--
-- Purpose:
-- -------
--     Inserts an identifier item into a named list.  Specifying Position
--     as zero results in the identifier being at the head of the List.
--     Use_Error or Search_Error may be raised indicating identifier item
--     has not been inserted.
--
-- Parameters:
-- ----------
--     List       is the named list of interest
--     List_Item  is the identifier value to be inserted
--     Named      is the name of an identifier in List which will be replaced
--     Position   is the position of the item after which the Identifier is
--                inserted
-- Exceptions:
-- ----------
--     Use_Error     is raised if this is a positional list,
--                   or if position exceeds the size of the list.
--
-- Notes: MIL_STD CAIS 5.4.1.20.6
-- -----
--
----------------------------------------------------------------
    procedure Insert(List      : in out List_Type;
                     List_Item : in Token_Type;
                     Named     : in Namestring;
                     Position  : in Count) is
        Current  : List_Type;       --ptr to list item to insert after
        New_Item : List_Type;       --ptr to area where new list item is built
    begin
        if Position /= 0 then
            Find_All(List, Position, Current);
        end if;
        if List /= null and then List.Name = null then
            raise Use_Error;            --Mixed Named/Positional Items
        end if;
        New_Item := new Item_Descriptor;

        --store value fields
        New_Item.Kind := Identifier_Item;
        Validate_Item(Named, Identifier_Item, New_Item.Name);
        Validate_Item(Retrieve(List_Item), Identifier_Item, New_Item.Element);

        --now set up pointers
        if Position /= 0 then
            New_Item.Next_Item := Current.Next_Item;    --simple item
            Current.Next_Item := New_Item;
        else
            New_Item.Next_Item := List;                 --head item
            List := New_Item;
        end if;
    end Insert;
-----------------I N S E R T--IDENTIFIER--NAMED---TOKEN-------------
--
-- Purpose:
-- -------
--     Inserts an identifier item into a named list.  Specifying Position
--     as zero results in the identifier being at the head of the List.
--     Use_Error or Search_Error may be raised indicating identifier item
--     has not been inserted.
--
-- Parameters:
-- ----------
--     List       is the named list of interest
--     List_Item  is the identifier value to be inserted
--     Named      is the name (in token format) of an identifier in List which
--                will be replaced
--     Position   is the position of the item after which the Identifier is
--                inserted
-- Exceptions:
-- ----------
--     Use_Error     is raised if this is a positional list,
--                   or if position exceeds the size of the list.
--
-- Notes: MIL_STD CAIS 5.4.1.20.6
-- -----
--
----------------------------------------------------------------

    procedure Insert(List      : in out List_Type;
                     List_Item : in Token_Type;
                     Named     : in Token_Type;
                     Position  : in Count) is
    begin
        Insert(List, List_Item, Retrieve(Named), Position);
    end Insert;
-----------P O S I T I O N _ B Y _ V A L U E------IDENTIFIER----------
--
-- Purpose:
-- -------
--     Returns the position at which the next identifier_item of the given
--     value is located. the search begins at the Start_Position and ends
--     when either an item of Value is found, the last item of the list
--     has been examined, or the item at the End_Position has been
--     examined, whichever comes first.
--
-- Parameters:
-- ----------
--     List           is the list_type of interest
--     Value          is the value of identifier being looked for
--     Start_Position is the position of the starting item in the search
--     End_Position   is the position of the ending   item in the search
--     return         the position of an item whose value matches
--
-- Exceptions:
-- ----------
--     Use_Error     raised if Start<End or Start > length of list
--     Search_Error  raised if Value not found in specified range
--
-- Notes: MIL_STD CAIS 5.4.1.20.7
-- -----
--
----------------------------------------------------------------
    function Position_By_Value(List           : in List_Type;
                               Value          : in Token_Type;
                               Start_Position : in Position_Count :=
                                   Position_Count'First;
                               End_Position   : in Position_Count :=
                                   Position_Count'Last) return Position_Count
        is
        Pos     : Position_Count := 1;
        Current : List_Type := List;

    begin
        if Start_Position > End_Position then   --Valid Range??
            raise Use_Error;
        end if;

        while Pos < Start_Position loop         --Move to Start
            if Current = null then                  --End of list
                raise Use_Error;
            end if;

            Pos := Pos + 1;
            Current := Current.Next_Item;
        end loop;

        while Pos <= End_Position loop          --Check each item in range
            if Current = null then                  --End of List?
                raise Search_Error;
            end if;

            if Current.Kind = Identifier_Item and then Is_Equal(Current.Element
                , Value) then
                return Pos;                         --Match found
            end if;

            Pos := Pos + 1;
            Current := Current.Next_Item;
        end loop;

        raise Search_Error;                             --!!!No match
    end Position_By_Value;

end Identifier_Items;
--::::::::::::::
--invoke_process.a
--::::::::::::::


----------------------------------------------------------------------
--                            Invoke_Process
--
--
--               Separate subprogram in package Process_Control
--
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Wed Aug 21 21:16:42 EST 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

----------------- I N V O K E _ P R O C E S S  ----------------------
--
--  Purpose:
--  -------
--    This procedure creates a new process node whose contents represent
--    the execution of the program contained in the specified file node.
--    Control returns to the calling task after the new process is
--    terminated.
--
--  Parameters:
--  ----------
--    Node              - node handle returned open on the new process node
--    File_Node         - open node handle on the file node containing the
--                        executable image whose execution will be
--                        represented by the new process
--    Results_Returned  - list of results which are represented by strings
--                        from the new process.
--    Status            - the process status of the process.
--    Input_Parameters  - a list containing process parameter information.
--    Key               - the relationship key of the primary relationship
--                        from the current process node to the new process
--                        node.
--    Relation          - the relation name of the primary relationship
--                        from the current process node to the new node.
--    Access_Control    - defines the initial access control information
--                        associated with the created node.
--    Level             - defines the classification label for the created
--                        node.
--    Attributes        - a list which can be used to set attributes of the
--                        new node.
--    Input_File        - pathname for standard input for the new process
--    Output_File       - pathname for standard output for the new process
--    Error_File        - pathname for error output for the new process
--    Environment_Node  - the node the new process will have as its current
--                        node
--    Time_Limit        - the limit on the time that the calling task will
--                        be suspended awaiting the new process.  When
--                        the limit is exceeded, the calling task resumes
--                        execution.

--
--  Exceptions:
--  ----------
--    Name_Error        - raised if a node alreadyt exists for the
--                        relationship specified by Key and Relation.
--                        Name_Error is also raised if any of the nodes
--                        identified by Input_File, Output_File,
--                        Error_File, or Environment_Node do not exist.
--                        It is also raised if Key or Relation is
--                        syntactically illegal or if any node identifying
--                        a group specified in the given  Access_Control
--                        parameter is unobtainable or inaccessible.
--    Use_Error         - is raised if it can be determined that the node
--                        indicated by File_Node does not contain an executable
--                        image.  Use_Error is also raised if any of the
--                        parameters Input_Paramters, Level, Access_Control,
--                        or Attributes is syntactically illegal.  Use_Error
--                        is also raised if Relation is the name of a
--                        predefined relation or if the Attributes parameter
--                        contains references to a predefined attribute which
--                        cannot be modified or created by the user.
--    Status_Error      - is raised if Node is an open node handle prior to
--                        the call or if File_Node is not an open node handle.
--    Lock_Error        - is raised if access with intent Append_Relationships
--                        cannot be obtained to the current process node due
--                        to an existing lock on the node.
--    Intent_Violation  - is raised if the node designated by File_Node was
--                        not opened with an intent establishing the right
--                        to execute contents.
--
--  Notes:   MIL-STD-CAIS 5.2.2.3
--  -----
--
---------------------------------------------------------------------



with System;

separate(Cais.Process_Control)
procedure Invoke_Process(Node             : in out Node_Type;
                         File_Node        : Node_Type;
                         Results_Returned : in out Results_List;
                         Status           : in out Process_Status;
                         Input_Parameters : Parameter_List;
                         Key              : Relationship_Key := Latest_Key;
                         Relation         : Relation_Name := Default_Relation;
                         Access_Control   : List_Type := Empty_List;
                         Level            : List_Type := Empty_List;
                         Attributes       : List_Type := Empty_List;
                         Input_File       : Name_String := Current_Input;
                         Output_File      : Name_String := Current_Output;
                         Error_File       : Name_String := Current_Error;
                         Environment_Node : Name_String := Current_Node;
                         Time_Limit       : Duration := Duration'Last) is


    use Pragmatics;

    Result : Integer;
    Pgm    : String(1 .. Pragmatics.Max_Contents_File_Length);
    Length : Positive;

    function Simple_Fork(Pgmname : System.Address;
                         Chars   : Positive) return Integer;
    pragma Interface(C, Simple_Fork);

begin

    if Node_Representation.Open_Status(Node) then
        raise Node_Definitions.Status_Error;
    end if;

    Node_Representation.Get_Contents_File_Name(File_Node, Pgm, Length);
    Result := Simple_Fork(Pgm'Address, Length);
    if Result =  -1 then
        raise Node_Definitions.Use_Error;
    end if;

exception
    -- exceptions that are trapped (nothing propagated)
        -- NONE.
    -- exceptions that are propagated
    when Node_Definitions.Use_Error | Node_Definitions.Status_Error =>
        raise;
    -- exceptions that are mapped to other exceptions
        -- NONE.
    -- predefined exceptions (propagated with trace)
    when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
        Numeric_Error =>
        Trace.Report("PREDEFINED EXCEPTION in Invoke_Process ");
        raise;
    -- unanticipated exceptions
    when others =>
        Trace.Report("UNANTICIPATED EXCEPTION in Invoke_Process ");
        raise Trace.Assertion_Violation;

end Invoke_Process;
--::::::::::::::
--io_control_body.a
--::::::::::::::
with Trace;
separate(Cais)
package body Io_Control is
    use Io_Definitions;
    use Node_Definitions;
    use List_Utilities;

    procedure Open_File_Node(File       : File_Type;
                             Node       : in out Node_Type;
                             Intent     : Intention;
                             Time_Limit : Duration := No_Delay) is
    begin
        Trace.Assert_Fatal(False, "Open_File_Node is NOT implemented");
    end Open_File_Node;

    procedure Synchronize(File : File_Type) is
    begin
        Trace.Assert_Fatal(False, "Synchronize is NOT implemented");
    end Synchronize;

    procedure Set_Log(File     : File_Type;
                      Log_File : File_Type) is
    begin
        Trace.Assert_Fatal(False, "Set_Log is NOT implemented");
    end Set_Log;

    procedure Clear_Log(File : File_Type) is
    begin
        Trace.Assert_Fatal(False, "Clear_Log is NOT implemented");
    end Clear_Log;

    function Logging(File : File_Type) return Boolean is
    begin
        Trace.Assert_Fatal(False, "Logging is NOT implemented");
        return False;
    end Logging;

    function Get_Log(File : File_Type) return File_Type is
    begin
        Trace.Assert_Fatal(False, "Get_Log is NOT implemented");
        return File;
    end Get_Log;

    function Number_Of_Elements(File : File_Type) return Natural is
    begin
        Trace.Assert_Fatal(False, "Number_Of_Elements is NOT implemented");
        return 1;
    end Number_Of_Elements;

    procedure Set_Prompt(Terminal : File_Type;
                         Prompt   : String) is
    begin
        Trace.Assert_Fatal(False, "Set_Prompt is NOT implemented");
    end Set_Prompt;

    function Get_Prompt(Terminal : File_Type) return String is
    begin
        Trace.Assert_Fatal(False, "Get_Prompt is NOT implemented");
        return "";
    end Get_Prompt;

    function Intercepted_Characters(Terminal : File_Type) return Character_Array
        is
    begin
        Trace.Assert_Fatal(False, "Intercepted_Characters is NOT implemented");
        return (Character'First .. Character'Last => False);
    end Intercepted_Characters;

    procedure Enable_Function_Keys(Terminal : File_Type;
                                   Enable   : Boolean) is
    begin
        Trace.Assert_Fatal(False, "Enable_Function_Keys is NOT implemented");
    end Enable_Function_Keys;

    function Function_Keys_Enabled(Terminal : File_Type) return Boolean is
    begin
        Trace.Assert_Fatal(False, "Function_Keys_Enabled is NOT implemented");
        return False;
    end Function_Keys_Enabled;

    procedure Couple(Queue_Base     : Node_Type;
                     Queue_Key      : Relationship_Key := Latest_Key;
                     Queue_Relation : Relation_Name := Default_Relation;
                     File_Node      : Node_Type;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type;
                                            -- intentionally no default
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is
    begin
        Trace.Assert_Fatal(False, "Couple is NOT implemented");
    end Couple;

    procedure Couple(Queue_Name     : Name_String;
                     File_Node      : Node_Type;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type;
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is
    begin
        Trace.Assert_Fatal(False, "Couple is NOT implemented");
    end Couple;

    procedure Couple(Queue_Base     : Node_Type;
                     Queue_Key      : Relationship_Key := Latest_Key;
                     Queue_Relation : Relation_Name := Default_Relation;
                     File_Name      : Name_String;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type;
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is
    begin
        Trace.Assert_Fatal(False, "Couple is NOT implemented");
    end Couple;

    procedure Couple(Queue_Name     : Name_String;
                     File_Name      : Name_String;
                     Form           : List_Type := Empty_List;
                     Attributes     : List_Type;
                     Access_Control : List_Type := Empty_List;
                     Level          : List_Type := Empty_List) is
    begin
        Trace.Assert_Fatal(False, "Couple is NOT implemented");
    end Couple;



end Io_Control;
--::::::::::::::
--iterator_support_body.a
--::::::::::::::


----------------------------------------------------------------------
--                      ITERATOR_SUPPORT
--                       (Package Body)
--
--
--      This Package provides routines which support the pattern
--          matching and sorting requirements of iterators
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Wed Oct  9 14:27:30 EDT 1985
--
--                 (Unclassified and uncopyrighted)
----------------------------------------------------------------------
----------------------------------------------------------------------
--
--  Purpose:
--  --------
--    This   package  provides  routines  which  support  pattern  matching
--    (including * and ? wild card characters)  and the  creation of sorted
--    lists.  These  capabilities are  required  for the  implementation of
--    Node and Attribute Iterators.  The iterator is  implemented as a list
--    of the format defined by the  package  CAIS_list_utilities (CAIS  1.4
--    section  5.4).
--
--  Usage:
--  -----
--    Patterns are represented by character strings, which must conform  to
--    the rules for Ada identifiers except that wildcard characters  may be
--    included.  A routine is provided to validate patterns to these rules.
--    Another routine matches a token against a  pattern and another  finds
--    the lexicographic position within an already sorted list at which  to
--    insert a token.
--
--  Example:
--  -------
--    Verify_Pattern("*_body?");            --valid pattern
--    Verify_Pattern("*__spec");            --use_error __
--    Verify_Pattern("*.body?");            --use_error . no good
--                --checks attribute against pattern and if
--                --it matches saves it in alphabetized list
--    if Pattern_Match(Attribute,"T???") then
--        Insert(Found, Attribute, Lexical_Position(Found, Attribute));
--    end if;
--
--  Notes:
--  -----
--    This is a version of the package CAIS_ATTRIBUTES,  specified  in
--    MIL-STD-CAIS section 5.1.3; all references to the CAIS specification
--    refer to the MIL-STD-CAIS specification dated 31 January 1985.
--
--  Revision History:
--  ----------------
--    12-04-85    Removed reference to V_String.  The > function for
--            tokens was copied from V_String into Lexical_Position
-------------------------------------------------------------------

separate(Cais)
package body Iterator_Support is

    use List_Utilities;
    use Node_Definitions;
    use Identifier_Items;
----------------------   Lexical_Position     ---------------------------
--
--  Purpose: This function searches an alphebetized list returning the
--  -------  position at which the new named item should be inserted
--
--  Parameters:
--  ----------
--    List    is the named list being searched (names are assumed to be sorted)
--    Name    is the name of the new item to be inserted
--    returns Pos where the named item should be inserted
--
--  Exceptions:
--  ----------
--   None
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
    function Lexical_Position(List : in List_Type;
                              Name : in Token_Type) return Count is
        Pos       : Count := Length(List);
        List_Name : Token_Type;


--------------------------------------------------------------------------
--   >  Compares two Tokens on a character-by-character basis. Longer
--    Tokens whose heads match another Token are considered >.
--    Greater means later in alphanumeric order.  That is:
--        z > a        zz > z      a2 > a1
--------------------------------------------------------------------------
        function ">"(L_Side : in Token_Type;
                     R_Side : in Token_Type) return Boolean is
            Left_Side    : String(1 .. To_Text(L_Side)'Length) := To_Text(L_Side
                );
            Right_Side   : String(1 .. To_Text(R_Side)'Length) := To_Text(R_Side
                );
            Minimum_Size : Integer;
                                   --The smaller of the two sizes
            Greater_Than : Boolean;
                                   --Holds comaprison results as each character
                                   --is checked
        begin
            if Left_Side'Length = 1 and then Left_Side(1) = Ascii.Nul then
                                                                --Left null
                return False;
            elsif Right_Side'Length = 1 and then Right_Side(1) = Ascii.Nul then
                                                                --Right null
                return True;
            else                                                --Two strings
                if Left_Side'Length > Right_Side'Length then
                    Minimum_Size := Right_Side'Length;
                    Greater_Than := True;       --wins  if substrings match
                else
                    Minimum_Size := Left_Side'Length;
                    Greater_Than := False;      --fails if substrings match
                end if;

                for I in 1 .. Minimum_Size loop
                    if Left_Side(I) > Right_Side(I) then
                        Greater_Than := True;
                        exit;
                    elsif Left_Side(I) < Right_Side(I) then
                        Greater_Than := False;
                        exit;
                    end if;
                end loop;
                return Greater_Than;
            end if;
        end ">";



    begin
        for I in reverse 1 .. Length(List) loop
            Item_Name(List, I, List_Name);
            exit when Name > List_Name;
            Pos := Pos - 1;
        end loop;
        return Pos;
    end Lexical_Position;
----------------------   Verify_Pattern   --------------------------------
--
--  Purpose: This procedure checks that a Pattern string conforms to the
--  -------  syntax for identifiers with the addition of wildcard characters
--           '?' and '*'.  It also allows trailing blanks and returns the
--           length of the pattern minus any trailing blanks.
--
--  Parameters:
--  ----------
--    Pattern      is the pattern string to be checked for conformance
--    Size       is returned with the length of Pattern less trailing ' 's
--
--  Exceptions:
--  ----------
--   Use_Error       is raised if the pattern fails conformance
--
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
    procedure Verify_Pattern(Pattern : in String;
                             Size    : in out Integer) is
        Work_Pattern : String(Pattern'First .. Pattern'Last) := Pattern;
        Token        : Token_Type;
    begin
        Size := Pattern'Last;                   --Remove trailing blanks
        while Work_Pattern(Size) = ' ' loop
            if Size = Pattern'First then                --All blanks
                raise Use_Error;
            end if;
        end loop;

        for I in 1 .. Size loop                 --Convert wildcards
            if Work_Pattern(I) = '?' then
                Work_Pattern(I) := 'A';
            elsif Work_Pattern(I) = '*' then
                Work_Pattern(I) := 'A';
            end if;
        end loop;
                                                --Check Syntax
        Identifier_Items.To_Token(Work_Pattern(Pattern'First .. Size), Token);

    end Verify_Pattern;
----------------------   Pattern_Match   ---------------------------
--
--  Purpose: returns true if Canditate string conforms to the pattern
--  -------  which may contain ?s (any character) or *s (any string).
--
--  Parameters:
--  ----------
--    Candidate is a character string to be checked for conformance
--    Pattern   is a character string which defines conformance rules
--
--  Exceptions: None
--  ----------
--
--  Notes:
--  -----
--
---------------------------------------------------------------------------
    function Pattern_Match(Candidate : in String;
                                        --string to be checked
                           Pattern   : in String)
                                        --acceptance criteria
    return Boolean is
        Can_Pos : Integer := 0;  --position of current character in Candidate
        Pat_Pos : Integer := 0;  --position of current character in Pattern
        Restart : Integer := 0;  --position in Pattern at which to resume
                                 --after a character mismatch

        procedure Get_Pattern_Pos is
        begin
            Pat_Pos := Pat_Pos + 1;       --Get next pattern char, check for *
            while Pat_Pos <= Pattern'Length and then Pattern(Pat_Pos) = '*' loop
                                          --A string of *s is equivalent to a
                Pat_Pos := Pat_Pos + 1;           --single *
                Restart := Pat_Pos;
            end loop;
        end Get_Pattern_Pos;

        function Character_Match        --performs a single character test
        return Boolean is               --for equality regardless of case
        begin                           --and always recognizing ? as a match
            if Pattern(Pat_Pos) = '?' then                        --wildcard
                return True;
            elsif Candidate(Can_Pos) = Pattern(Pat_Pos) then      --exact match
                return True;
            elsif Pattern(Pat_Pos) in 'a' .. 'z' and then Character'Val(
                Character'Pos(Pattern(Pat_Pos)) - 32) =           --raise case
            Candidate(Can_Pos) then
                return True;
                                                --Note, there is no need
                                                --to lower case since
                                                --all candidates are
                                                --upper case
            else
                return False;
            end if;
        end Character_Match;

    begin
        Get_Pattern_Pos;                    --Get 1st pattern char, check for *

                --On each pass of this loop a new character is pulled
                --from the candidate string.  On matches, a new
                --character is pulled from the pattern.  On mismathches
                --the pattern is reset to the most recent * or failure
                --is reported.
        while Pat_Pos <= Pattern'Length loop
            Can_Pos := Can_Pos + 1;         --Get next candidate char
            if Can_Pos > Candidate'Length then
                                            --Match fails because pattern
                return False;               --still expects more characters
            end if;

            if Character_Match then                             --char or wildcard match
                Get_Pattern_Pos;
                if Pat_Pos > Pattern'Last and then      --after a match, if the
                Can_Pos < Candidate'Last and then       --pattern is exhausted
                Restart /= 0 then                       --and the candidate is
                    Pat_Pos := Restart;                 --not, and a * occurred
                end if;                                 --restart.  But don't
                                                        --recheck this char.
                                                        --ex.  xxaa .vs. *a

            elsif Restart /= 0 then                     --*_string   match
                Pat_Pos := Restart;                                --so reset pattern
                if Character_Match then                    --recheck this char
                    Get_Pattern_Pos;
                end if;

            else                                        --match fails
                return False;
            end if;
        end loop;

                --At end of loop the pattern has been exhausted.
                --A match occurs if candidate is also exhausted
                --or if last pattern character was a *.
        if Can_Pos = Candidate'Length then
            return True;
        elsif Pattern(Pattern'Length) = '*' then
            return True;
        else
            return False;
        end if;
    end Pattern_Match;

end Iterator_Support;
--::::::::::::::
--list_utilities_body.a
--::::::::::::::



----------------------------------------------------------------------
--                   L I S T _ U T I L I T I E S
--                          (Package Body)
--
--           Operations for manipulating objects of List_Type
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Tue Oct  8 16:40:23 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--                   L I S T _ U T I L I T I E S
--
--  Purpose:
--  -------
--    List_Utilities provides operations for objects of List_Type.  These
--    objects are heterogeneous lists of string, integer, float, sub-list,
--    and list items.  Operations provided include Insert, Extract, Replace,
--    Delete, and a value search.  Conmversions to and from text are also
--    provided.  Lists may be named or unnamed.  Related packages are
--    String_Items, Identifier_Items, Integer_Items, and Float_Items.
--
--  Usage:
--  -----
--    Lists are used to represent attribute values and parameters in CAIS.
--    Implementations may use Lists to represent relationships.
--
--  Example:
--  -------
--        To_List("(Integers=>(1,2), Identifier=>Ada_Name)", Sample);
--        Extract(Sample, 1, Integer_List);
--
--  Notes:
--  -----
--    The visibility of the internal package V_String is questionable and
--    should possibly be hidden.
--
--  Revision History:
--  ----------------
--    12-01-85 Removed enclosing (and doubled) quotes from the internal
--         representation of string_items.  Quotes must now be added
--         for external representations of list.
--          #Validate_Items: avoided using Parse_Token on string_items
--          #To_Text: appende enclosing "s and doubled embedded "s
--          #Text_Length: increased count by (2 + No. of embedded "s)
--          #Text_Length(Items): now return Natural since length may be 0
--    12-01-85 Added specification for V_String which was removed from
--         List_Utilities-Spec.  V_String is now hidden in List_Utilities
-------------------------------------------------------------------

separate(Cais)
package body List_Utilities is

    use Node_Definitions;

--------------------------------------------------------------------------
--   S E P A R A T E     P A C K A G E   V _ S T R I N G
--Processing support for Token_Type
--------------------------------------------------------------------------
    package V_String is

        procedure Store(String_Value : in String;
                        Access_Key   : in out Token_Type);

        function Retrieve(Access_Key : in Token_Type) return String;

        function Length(Access_Key : in Token_Type) return Natural;

        function Is_Equal(Left_Side  : in Token_Type;
                          Right_Side : in Token_Type) return Boolean;

        function ">"(Left_Side  : in Token_Type;
                     Right_Side : in Token_Type) return Boolean;

        function Is_Equal(Left_Side  : in Token_Type;
                          Right_Side : in String) return Boolean;

        procedure Copy(To   : in out Token_Type;
                       From : in Token_Type);
    end V_String;
    package body V_String is separate;
    use V_String;

    procedure Dump(List : in List_Type) is separate;

--------------P O S I T I O N _ O F------POSITIONAL ITEM------------------
--
-- Purpose:
-- -------
--     Searches a list for the position corresponding to the item pointer
--
-- Parameters:
-- ----------
--     List       is the list_type to be searched, either named or positional
--     This_Item  is a ptr to an item within List
--     return     the position of This_Item within List
--
-- Exceptions:
-- ----------
--     None
--
-- Notes:
-- -----
--     Assumes that the item pointer validly points to an item within the
--     list.
--
----------------------------------------------------------------
    function Position_Of(List      : List_Type;
                                           --list to be searched
                         This_Item : in List_Type)
                                           --pointer to desired item
    return Position_Count is               --Position of desired item
        Position : Position_Count := 1;
        Current  : List_Type := List;
    begin
        while This_Item /= Current loop
            Position := Position + 1;
            Current := Current.Next_Item;
        end loop;
        return Position;
    end Position_Of;

------------------F I N D------POSITIONAL ITEM------------------
--
-- Purpose:
-- -------
--     Searches an unnamed list for the nth item.
--
-- Parameters:
-- ----------
--      List       is the list to be searched, must be unnamed
--      Index      is the Position of desired item
--      Current    is the pointer computed for desired item
--
--
-- Exceptions:
-- ----------
--     Use_Error        is raised if this is a named list
--                      or if Position > no. items in list
--
-- Notes:
-- -----
--    None
--
----------------------------------------------------------------
    procedure Find(List    : List_Type;    --list to be searched
                   Index   : Position_Count;
                                           --Position of desired item
                   Current : in out List_Type) is
                                           --pointer to desired item
    begin
        if List /= null and then List.Name /= null then
            raise Use_Error;                            --Named List!!
        end if;

        Current := List;
        for I in 1 .. Index - 1 loop
            Current := Current.Next_Item;
        end loop;
        if Current = null then
            raise Use_Error;                     --Position too high!!
        end if;
    exception
        when Constraint_Error =>
            raise Use_Error;
    end Find;

------------------F I N D _ A L L------POSITIONAL ITEM IN ANY LIST----
--
-- Purpose:
-- -------
--     Searches either an unnamed or a named list for the nth item.
--     This is identical to the Find for a positional list except that
--     here no Use_Error is raised.
--
-- Parameters:
-- ----------
--      List       is the list to be searched, may be either named or unnamed
--      Index      is the Position of desired item
--      Current    is the pointer computed for desired item
--
--
-- Exceptions:
-- ----------
--      Use_Error     is raised if Position > no. items in list
--
-- Notes:
-- -----
--    None
--
----------------------------------------------------------------
    procedure Find_All(List    : List_Type; --list to be searched
                       Index   : Position_Count;
                                            --Position of desired item
                       Current : in out List_Type) is
                                            --pointer to desired item
    begin

        Current := List;
        for I in 1 .. Index - 1 loop
            Current := Current.Next_Item;
        end loop;
        if Current = null then
            raise Use_Error;                     --Position too high!!
        end if;
    exception
        when Constraint_Error =>
            raise Use_Error;
    end Find_All;
------------------F I N D------NAMED      ITEM------------------
--
-- Purpose:
-- -------
--     Searches an named list for the  item with matching name.
--
--
--
-- Parameters:
-- ----------
--      List       is the list to be searched, must be named
--      Named      is the Name of desired item
--      Current    is the pointer computed for desired item
--
--
--
-- Exceptions:
-- ----------
--     Use_Error        is raised if this is an unnamed list
--     Search_Error     is raised if Position > no. items in list
--
--
-- Notes:
-- -----
--     None
--
----------------------------------------------------------------
    procedure Find(List    : List_Type;        --list to be searched
                   Named   : Namestring;      --Name of desired item
                   Current : in out List_Type) is
                                               --pointer to desired item

    begin
        if List /= null and then List.Name = null then
            raise Use_Error;                            --UNNamed List!!
        end if;

        Current := List;
        if Current = null then
            raise Use_Error;
        end if;
        while not Is_Equal(Current.Name, Named) loop
            Current := Current.Next_Item;
            if Current = null then
                raise Search_Error;                     --Position too high!!
            end if;
        end loop;
    end Find;

-------------------N A M E _ C H E C K---NAME vs LIST-----------
--
-- Purpose:
-- ---------
--    Checks the provided name against each name in the list and
--    raises use error if a match occurs.
--
-- Parameters:
-- ----------
--    List    is an existing named list whose names are searched
--    Named   is the candidate name being checked for uniqueness
--
-- Exceptions:
-- ----------
--    Use_Error is raised if Name matches any of the item names in list
--
-- Notes:
-- -----
--    None
----------------------------------------------------------------
    procedure Name_Check(List  : in List_Type;
                         Named : in Token_Type) is
        Current : List_Type := List;
    begin
        while Current /= null loop
            if Is_Equal(Current.Name, Named) then
                raise Use_Error;
            end if;
            Current := Current.Next_Item;
        end loop;
    end Name_Check;
-------------------N A M E _ C H E C K---LIST vs LIST-----------
--
-- Purpose:
-- ---------
--    Checks each name in the first list against each name in the
--    second list and raises use error if a match occurs.
--
-- Parameters:
-- ----------
--    List1   is an existing named list whose names are searched
--    List2   is a second list whose names must be unique from List2
--
-- Exceptions:
-- ----------
--    Use_Error is propogated if any Name from List1 matches any
--              of the item names in list2
--
-- Notes:
-- -----
--    None
----------------------------------------------------------------
    procedure Name_Check(List1 : in List_Type;
                         List2 : in List_Type) is
        Current : List_Type := List2;
    begin
        while Current /= null and then Current.Name /= null loop
            Name_Check(List1, Current.Name);
            Current := Current.Next_Item;
        end loop;
    end Name_Check;
------------------------------------------------------------------
--           D E C L A R E         P A R S E _ T O K E N (RECURSIVE)
------------------------------------------------------------------
    procedure Parse_Token(List_Literal : in List_Text;
                          Pos          : in out Natural;
                          Token        : in out String;
                          Token_Pos    : in out Natural;
                          Token_Kind   : in out Item_Kind;
                          Sublist      : in out List_Type);



----------------------------------------------------------------------
--           S E P A R A T E       P A R S E _ L I S T
----------------------------------------------------------------------
    procedure Parse_List(List_Literal : in String;
                                           --text being parsed
                         Pos          : in out Natural;
                                           --next char to be viewed
                         List         : in out List_Type) is separate;



------------------------------------------------------------------
--           S E P A R A T E       P A R S E _ T O K E N
------------------------------------------------------------------
    procedure Parse_Token(List_Literal : in List_Text;
                          Pos          : in out Natural;
                          Token        : in out String;
                          Token_Pos    : in out Natural;
                          Token_Kind   : in out Item_Kind;
                          Sublist      : in out List_Type) is separate;
------------------V A L I D A T E - I T E M---------------------
--
-- Purpose:
-- ---------
--    Parses an input character string, determining the Item_Kind and
--    compares that against the desired Item_Kind.  If the string parses
--    properly and is of the proper Item_Kind, then Validate_Token returns
--    the token representation of string in Token.  Otherwise Use error is
--    raised.
--
-- Parameters:
-- ----------
--    List_Item     is the character string to be parsed
--    Kind_Of_Item  is the required Item_Type
--    Token         is the validated Token_Type which is returned
--
-- Exceptions:
-- ----------
--    Use_Error is raised for illegally formed strings or for a string of
--              an Item_Kind other than the one desired
--
-- Notes:
-- -----
--    None
---------------------------------------------------------------------
    procedure Validate_Item(List_Item    : in String;
                            Kind_Of_Item : in Item_Kind;
                            Token        : in out Token_Type) is
        Pos        : Natural := List_Item'First;
                                    --set by Parse_Token to last char processed
        Token_Val  : String(1 .. List_Item'Length);  --value from Parse_Token
        Token_Size : Natural := 0;  --length of Token returned by Parse_Token
        Token_Kind : Item_Kind;     --kind of Token found by Parse_Token
        Sublist    : List_Type;     --required by Parse_Token, only for lists
    begin
        if Kind_Of_Item = String_Item then      --Don't check strings.  Quotes
            Store(List_Item, Token);            --aren't required except as
            return;                             --part of a list.  All strings
        end if;                                 --are valid.


        Parse_Token(List_Item & ')', Pos, Token_Val, Token_Size, Token_Kind,
            Sublist);
        if Token_Kind /= Kind_Of_Item or Pos <= List_Item'Length or
    (Token_Kind = Item_Kind'(List_Utilities.List_Item) and
    Pos > List_Item'Length) then
            raise Use_Error;
        end if;

        Store(Token_Val(1 .. Token_Size), Token);
    end Validate_Item;
-----------------------C O P Y----------------------------------
--
-- Purpose:
-- ---------
--    Returns in the the parameter T0_List a copy of the list value
--    of the parameter From_List.  Subsequent modification of either
--    list does not affect the other list.
--
-- Parameters:
-- ----------
--    To_List   is the list returned as a copy of the value of From_List
--    From_List is thew list to be copied.
--
-- Exceptions:
-- ----------
--    None
--
-- Notes: MIL_STD CAIS 5.4.1.2
-- -----
--    None
----------------------------------------------------------------
    procedure Copy(To_List   : in out List_Type;
                   From_List : in List_Type) is
        Local_List : List_Type;   --required because Merge is in out
    begin
        Merge(null, From_List, Local_List);
        To_List := Local_List;
    end Copy;
---------------------T O _ L I S T------------------------------
--
-- Purpose:
-- -------
--     Converts the external representation of a list to List_Type
--     and returns the converted value.  This function establishes
--     the list to be of named, unnamed, or null kind.
--
-- Parameters:
-- ----------
--     List_Literal is the string representation to be converted to a list
--     List         is the List_Type internal representation of List_Literal
--
--
-- Exceptions:
-- ----------
--     Use_Error is raised if ther is a syntax error.
--
-- Notes:  MIL_STD CAIS 5.4.1.3
-- -----
--
----------------------------------------------------------------

    procedure To_List(List_Literal : in List_Text;
                      List         : in out List_Type) is
        Size : constant Natural := List_Literal'Length;
        Pos  : Natural := 1;
    begin
        List := null;                      --Initialize to null list;

        Parse_List(List_Literal, Pos, List);
        if Pos <= Size then                --illegal chars after list
            raise Use_Error;
        end if;
    end To_List;


--------------------T O _ T E X T-------------------------------
--
-- Purpose:
-- -------
--     Returns thje external representation of the value of
--     list, as defined in MIL_STD CAIS 5.4
--
--
-- Parameters:
-- ----------
--     List   is a list_type to be converted to text
--     return string representation of List
--
-- Exceptions:
-- ----------
--     None
--
--
--
-- Notes: MIL_STD CAIS 5.4.1.4
-- -----
--
--
----------------------------------------------------------------

    function To_Text(List : in List_Type) return List_Text is
        Text     : String(1 .. Text_Length(List));
                                                  --work area
        Unquoted : String(1 .. Text_Length(List));
                                                  --string item without "
        Size     : Natural;                       --length of unquoted string
        Pos      : Positive := 2;                 --1st position to set
        Epos     : Natural;                       --End of text for this item
        Item     : List_Type := List;             --Item being processed;
    begin
        if List = null then
            Text(1 .. 2) := "()";
        else
            Text(1) := '(';

            while Item /= null loop
                if Item.Name /= null then       --add name text
                    Epos := Pos + Length(Item.Name) + 2;
                    Text(Pos .. Epos - 3) := Retrieve(Item.Name);
                    Text(Epos - 2 .. Epos - 1) := "=>";
                    Pos := Epos;
                end if;

                                                                --add item text
                if Item.Kind = List_Item then           --list_item
                    Epos := Pos + Text_Length(Item.List);
                    Text(Pos .. Epos - 1) := To_Text(Item.List);
                elsif Item.Kind = String_Item then      --string_item
                    Size := Length(Item.Element);
                    Unquoted(1 .. Size) := Retrieve(Item.Element);
                    Epos := Pos + Size + 2;
                    Text(Pos) := '"';
                    Pos := Pos + 1;
                    for I in 1 .. Size loop
                        Text(Pos) := Unquoted(I);
                        Pos := Pos + 1;
                        if Unquoted(I) = '"' then
                            Text(Pos) := '"';
                            Pos := Pos + 1;
                            Epos := Epos + 1;
                        end if;
                    end loop;
                    Text(Pos) := '"';
                else                                    --other items
                    Epos := Pos + Length(Item.Element);
                    Text(Pos .. Epos - 1) := Retrieve(Item.Element);
                end if;

                Text(Epos) := ',';      --add comma separator
                Pos := Epos + 1;
                Item := Item.Next_Item;
            end loop;
            Pos := Pos - 1;             --write over last ','
            Text(Pos) := ')';
        end if;
        return Text(1 .. Pos);
    end To_Text;
--------------------I S _ E Q U A L-----------------------------
-- Purpose:
-- -------
--     returns True if the two lists are equal as determined by:
--    - Both lists are of the same kind (named, unnamed, or empty)
--    - Both lists contain the same number of items
--    - For each position, the values of list items at this position,
--      as obtained by Extract, are of the same kind and are equal
--      under the equality defined for this kind
--    - In thew case of named lists, for each position, the names of the
--      items at this position are equal under Token_Type equality
--
-- Parameters:
-- ----------
--        List1  is List_Type to be compared
--        List2  is List_Type to be compared
--        return TRUE if lists are of the same kind, have the same number
--         of items, and all corresponding names and items are equal
--
-- Exceptions:
-- ----------
--      None
--
-- Notes: MIL_STD CAIS 5.4.1.5
-- -----
--
----------------------------------------------------------------
    function Is_Equal(List1 : in List_Type;
                      List2 : in List_Type) return Boolean is
        Item1 : List_Type := List1;  --ptr to an item in List1;
        Item2 : List_Type := List2;  --ptr to an item in List2;
    begin
        while Item1 /= null and Item2 /= null loop
                                                 --check each item for mismatch
            if Item1.Kind = Item2.Kind and                 --Kind
            Is_Equal(Item1.Name, Item2.Name) and           --Name

            ((Item1.Kind /= List_Item and then             --element
        Is_Equal(Item1.Element, Item2.Element)) or else

            (Item1.Kind = List_Item and then               --List, if apropos
            Is_Equal(Item1.List, Item2.List))) then
                Item1 := Item1.Next_Item;
                Item2 := Item2.Next_Item;
            else
                exit;
            end if;
        end loop;

        if Item1 = null and Item2 = null then
            return True;
        else
            return False;
        end if;
    end Is_Equal;

--------------------D E L E T E----POSITIONAL ITEM--------------
--
-- Purpose:
-- -------
--     Removes the list item at this position from the list
--
--
-- Parameters:
-- ----------
--     List     is the list from which an item is to be deleted, positional
--     Position is the position of the item to be deleted.
--
--
-- Exceptions:
-- ----------
--     Use_Error    may be raised by Find if bad position
--
--
-- Notes: MIL_STD CAIS 5.4.1.6
-- -----
--
--
----------------------------------------------------------------

    procedure Delete(List     : in out List_Type;
                     Position : in Position_Count) is
        Previous : List_Type;    --next is reset to point to item after current
        Current  : List_Type;    --item which is removed

    begin
        Find_All(List, Position, Current);
        if Position = 1 then                 --head  item being deleted
            List := Current.Next_Item;
        else                                 --other item being deleted
            Find_All(List, Position - 1, Previous);
            Previous.Next_Item := Current.Next_Item;
        end if;
    end Delete;
--------------------D E L E T E----NAMED     ITEM--------------
--
-- Purpose:
-- -------
--     Removes the list item of this name  from the list
--
--
-- Parameters:
-- ----------
--     List     is the list from which an item is to be deleted, named
--     Named    is the name of the item to be deleted.
--
--
-- Exceptions:
-- ----------
--     Search_Error    may be raised by find if name doesn't exist
--     Use_Error       may be raised by find if list is not named
--
--
-- Notes: MIL_STD CAIS 5.4.1.6
-- -----
--
--
----------------------------------------------------------------

    procedure Delete(List  : in out List_Type;
                     Named : in Namestring) is
        Previous : List_Type;    --next is reset to point to item after current
        Current  : List_Type;    --item which is removed
        Position : Position_Count; --Used to find previous item

    begin
        Find(List, Named, Current);
        Position := Position_Of(List, Current);
        if Position = 1 then                 --head  item being deleted
            List := Current.Next_Item;
        else                                 --other item being deleted
            Find_All(List, Position - 1, Previous);
            Previous.Next_Item := Current.Next_Item;
        end if;
    end Delete;
--------------------D E L E T E----NAMED  ITEM OF TOKEN TYPE---
--
-- Purpose:
-- -------
--     Removes the list item of this name  from the list
--
--
-- Parameters:
-- ----------
--     List     is the list from which an item is to be deleted, named
--     Named    is the name (in token form) of the item to be deleted.
--
--
-- Exceptions:
-- ----------
--     Search_Error    may be raised by find if name doesn't exist
--     Use_Error       may be raised by find if list is not named
--
--
-- Notes: MIL_STD CAIS 5.4.1.6
-- -----
--
--
----------------------------------------------------------------

    procedure Delete(List  : in out List_Type;
                     Named : in Token_Type) is

    begin
        Delete(List, Retrieve(Named));
    end Delete;
---------------G E T _ L I S T _ K I N D----------------OF LIST-
--
-- Purpose:
-- -------
--     Returns the kind of list, either empty, unnamed, or named.
--
-- Parameters:
-- ----------
--     List    is the list_type being looked at
--     return  the kind of list, either empty, unnamed, or named
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.7
-- -----
--
----------------------------------------------------------------

    function Get_List_Kind(List : in List_Type) return List_Kind is


    begin
        if List = null then
            return Empty;
        elsif List.Name = null then
            return Unnamed;
        else
            return Named;
        end if;
    end Get_List_Kind;
----------------G E T _ I T E M _ K I N D------------OF UNNAMED ITEM--
--
-- Purpose:
-- -------
--     Returns the kind of a single list item within an unnamed list.
--     The item kinds are LIST_ITEM, STRING_ITEM, INTEGER_ITEM,
--     REAL_ITEM, and IDENTIFIER_ITEM.
--
-- Parameters:
-- ----------
--     List      is the unnamed list containing the item of interest
--     Position  is the position of the item of interest
--     return    the item_kind of the specified item
--
-- Exceptions:
-- ----------
--     Use_Error       may be propogated by Find for no names or bad position
--
-- Notes: MIL_STD CAIS 5.4.1.8
--
------------------------------------------------------------------------------

    function Get_Item_Kind(List     : in List_Type;
                           Position : in Position_Count) return Item_Kind is

        Previous : List_Type; --returned by find but unused
        Current  : List_Type; --set by Find to item in question

    begin
        Find_All(List, Position, Current);
        return Current.Kind;
    end Get_Item_Kind;
----------------G E T _ I T E M _ K I N D------------OF NAMED ITEM--
--
-- Purpose:
-- -------
--     Returns the kind of a single list item within a named list.
--     The item kinds are LIST_ITEM, STRING_ITEM, INTEGER_ITEM,
--     REAL_ITEM, and IDENTIFIER_ITEM.
--
-- Parameters:
-- ----------
--     List      is the named list containing the item of interest
--     Named     is the name of the item of interest
--     return    the item_kind of the specified item
--
-- Exceptions:
-- ----------
--     Search_Error    may be propogated from Find if name doesn't exist
--     Use_Error       may be propogated by Find if list is unnamed
--
-- Notes: MIL_STD CAIS 5.4.1.8
-- -----
--
----------------------------------------------------------------

    function Get_Item_Kind(List  : in List_Type;
                           Named : in Namestring) return Item_Kind is

        Previous : List_Type; --returned by find but unused
        Current  : List_Type; --set by Find to item in question

    begin
        Find(List, Named, Current);
        return Current.Kind;
    end Get_Item_Kind;
------------G E T _ I T E M _ K I N D--------OF NAMED ITEM-TOKEN---
--
-- Purpose:
-- -------
--     Returns the kind of a single list item within a named list.
--     The item kinds are LIST_ITEM, STRING_ITEM, INTEGER_ITEM,
--     REAL_ITEM, and IDENTIFIER_ITEM.
--
-- Parameters:
-- ----------
--     List      is the named list containing the item of interest
--     Named     is the name (in token form) of the item of interest
--     return    the item_kind of the specified item
--
-- Exceptions:
-- ----------
--     Search_Error    may be propogated from Find if name doesn't exist
--     Use_Error       may be propogated by Find if list is unnamed
--
-- Notes: MIL_STD CAIS 5.4.1.8
-- -----
--
----------------------------------------------------------------

    function Get_Item_Kind(List  : in List_Type;
                           Named : in Token_Type) return Item_Kind is

    begin
        return Get_Item_Kind(List, Retrieve(Named));
    end Get_Item_Kind;
-----------------------S P L I C E-----TEXT---------------------
--
-- Purpose:
-- -------
--     Inserts a list into a list.  The items in the list to be inserted
--     will become items in the resulting list.  Subsequent modifications
--     to the value of List or to the value of Sub_List do not affect the
--     other list.
--
-- Parameters:
-- ----------
--     List      is the list_type into which the Sub_List is to be added
--     Position  is the position within List at which Sub_List is added
--     Sub_List  is text which is an external representation of a string
--               a list_type is created from this string and added to list
--
-- Exceptions:
-- ----------
--     Use_Error   is raised if List and Sub_List are not of the same kind
--           and neither of them is Empty; if Sub_List contains a
--           name identical to one in List; if Position is too large;
--           or if List_Text is of invalid format.
--
-- Notes: MIL_STD CAIS 5.4.1.9
-- -----
--
----------------------------------------------------------------

   -- MIL_STD CAIS 5.4.1.9
    procedure Splice(List     : in out List_Type;
                     Position : in Position_Count;
                     Sub_List : in List_Text) is
        Local_List : List_Type;  --temp for converted Sub_List
    begin
        To_List(Sub_List, Local_List);
        Splice(List, Position, Local_List);
    end Splice;
-----------------------S P L I C E-----LIST---------------------
--
-- Purpose:
-- -------
--     Inserts a list into a list.  The items in the list to be inserted
--     will becomes items in the resulting list.  Subsequent modifications
--     to the value of List or to the value of Sub_List do not affect the
--     other list.
--
-- Parameters:
-- ----------
--     List      is the list_type into which the Sub_List is to be added
--     Position  is the position within List at which Sub_List is added
--     Sub_List  is an unchanged list_type, a copy of which is added to List
--
-- Exceptions:
-- ----------
--     Use_Error   is raised if List and Sub_List are not of the same kind
--           and neither of them is Empty; if Sub_List contains a
--           name identical to one in List; or if Position is too large.
--
-- Notes: MIL_STD CAIS 5.4.1.9
-- -----
--
----------------------------------------------------------------
    procedure Splice(List     : in out List_Type;
                     Position : in Position_Count;
                     Sub_List : in List_Type) is
        Last    : List_Type;    --set to last item in Sub_List
        Head    : List_Type;    --set to Item in List at indicated Position
        Tail    : List_Type;    --set to Item in List at Position+1
        New_Sub : List_Type;    --copy of Sub_List to be inserted

    begin
     --Perform sanity checks for valid Splice parameters
        if Sub_List = null then                                 --No-op complete
            return;
        elsif (List.Name = null and Sub_List.Name /= null) or   --mixed lists
        (List.Name /= null and Sub_List.Name = null) then
            raise Use_Error;
        else                                                    --Name conflict?
                                                                --bad position?
            Name_Check(List, Sub_List);
            Find_All(List, Position, Head);     --set end   of head section
            Tail := Head.Next_Item;             --set start of tail section
        end if;

    --Splice is properly specified, so do it
                        --Copy the Sub_List so that it is never modified
        Copy(New_Sub, Sub_List);
                        --Find the last position in Sub_List;
        Last := New_Sub;
        while Last.Next_Item /= null loop
            Last := Last.Next_Item;
        end loop;
                        --Now reset appropriate pointers
        Head.Next_Item := New_Sub;
        Last.Next_Item := Tail;
    end Splice;
----------------------M E R G E---------------------------------
--
-- Purpose:
-- -------
--     Returns in result a list which is constructed from the
--     parameters Front and Back.  The lists Front and Back
--     lists are not modified by this procedure.
--
-- Parameters:
-- ----------
--     Front  : is a List_Type which is read but unchanged
--     Back   : is a List_Type which is read but unchanged
--     Result : is a new list_type made up of Front catenated to Back
--
-- Exceptions:
-- ----------
--     Use_Error is raised if one list is named and one is not.
--
-- Notes: MIL_STD CAIS 5.4.1.10
-- -----
--
----------------------------------------------------------------

    procedure Merge(Front  : in List_Type;
                    Back   : in List_Type;
                    Result : in out List_Type) is
        Current     : List_Type; --ptr to element in Front or Back to copy
        Copied_Item : List_Type; --result item where date has just been copied
        New_Item    : List_Type; --newly allocated item where data is copied

        procedure Copy_Item(From_Item : in List_Type;
                            To_Item   : in out List_Type) is
        begin
            To_Item.Kind := From_Item.Kind;
            Copy(To_Item.Name, From_Item.Name);
            Copy(To_Item.Element, From_Item.Element);
            if From_Item.Kind = List_Item then
                Merge(null, From_Item.List, To_Item.List);
            else
                To_Item.List := null;
            end if;
        end Copy_Item;


    begin
        if (Front /= null and Back /= null) and then ((Front.Name = null and
            Back.Name /= null) or (Front.Name /= null and Back.Name = null))
            then
            raise Use_Error;
        else
            --first check for duplicate names
            Name_Check(Front, Back);

            --copy over Front list
            Result := null;
            Current := Front;
            while Current /= null loop
                Copied_Item := new Item_Descriptor;
                if Result = null then
                    Result := Copied_Item;
                else
                    New_Item.Next_Item := Copied_Item;
                end if;
                Copy_Item(Current, Copied_Item);

                --update pointers
                Current := Current.Next_Item;
                New_Item := Copied_Item;
            end loop;

            --copy over Back list
            Current := Back;
            while Current /= null loop
                Copied_Item := new Item_Descriptor;
                if Result = null then
                    Result := Copied_Item;
                else
                    New_Item.Next_Item := Copied_Item;
                end if;
                Copy_Item(Current, Copied_Item);

                --update pointers
                Current := Current.Next_Item;
                New_Item := Copied_Item;
            end loop;
        end if;

    end Merge;
-----------------S E T _ E X T R A C T--------------------------
--
-- Purpose:
-- -------
--     Extracts a (sub)list from a list.  The return value is a copy of the
--     list subset that starts at the item at Position and has Length items
--     in it.  If there are fewer than Length items in this part of the list,
--     the subset extends to the tail of the list.
--
-- Parameters:
-- ----------
--     List      is the list_type(unchanged) from which the sublist is read
--     Position  is position of the first item to be copied out
--     Length    is the number of items to be copied to the sublist
--     return    is the Text representation of the selected sublist
--
-- Exceptions:
-- ----------
--     Use Error     is raised if Position is larger than the list length
--
-- Notes: MIL_STD CAIS 5.4.1.11
-- -----
--
----------------------------------------------------------------

   -- MIL_STD CAIS 5.4.1.11
    function Set_Extract(List     : in List_Type;
                         Position : in Position_Count;
                         Length   : in Positive := Positive'Last) return
        List_Text is
        Start          : List_Type;
                                   --ptr to 1st  item to be extracted
        Stop           : List_Type;
                                   --ptr to last item to be extracted
        Relink         : List_Type;
                                   --ptr to item after the last one extracted
        Extracted_List : List_Type;
                                   --ptr to the copied list of items
    begin
        Find_All(List, Position, Start);    --Find start of Extracted List

        Stop := Start;                  --Find stop  of Extracted List
        for I in 1 .. Length - 1 loop
            exit when Stop.Next_Item = null;   --Check for end of List
            Stop := Stop.Next_Item;
        end loop;

        Relink := Stop.Next_Item;       --Save this link and then break it
        Stop.Next_Item := null;

        Copy(Extracted_List, Start);    --Copy list and mend the broken link
        Stop.Next_Item := Relink;

        return To_Text(Extracted_List);
    end Set_Extract;
--------------------L E N G T H------OF LIST--------------------
--
-- Purpose:
-- -------
--     Returns a count of the number of items in List. If list
--     is empty, Length returns zero.
--
-- Parameters:
-- ----------
--     List   is the list_type whose items are being counted
--     return the number of items (note list_items count as a single item)
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.12
-- -----
--     None
--
----------------------------------------------------------------

    function Length(List : in List_Type) return Count is

        Counter      : Count;
        Current_Item : List_Type;

    begin
        Counter := 0;
        Current_Item := List;
        while Current_Item /= null loop
            Counter := Counter + 1;
            Current_Item := Current_Item.Next_Item;
        end loop;
        return Counter;
    end Length;
------------------T E X T _ L E N G T H----OF LIST--------------
--
-- Purpose:
-- -------
--     Returns the length of a string representing a list according
--     to the syntax prescribed in MIL_STD CAIS
--
-- Parameters:
-- ----------
--     List   is the list being examined
--     return the length of the string which is the external text for List
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.13
-- -----
--     None
--
----------------------------------------------------------------

    function Text_Length(List : in List_Type) return Positive is
        Pos  : Positive := 2;          --Count parenthesis
        Item : List_Type := List;      --Item being processed;
    begin
        while Item /= null loop
            if Item.Name /= null then
                Pos := Pos + Length(Item.Name) + 2;     --count names
            end if;

            if Item.Kind = List_Item then
                Pos := Pos + Text_Length(Item.List);    --count list
            elsif Item.Kind = String_Item then          --for string items
                Pos := Pos + Length(Item.Element) + 2;   --add 2 for enclosing "
                declare
                    Element : String(1 .. Length(Item.Element));
                begin
                    Element := Retrieve(Item.Element);
                    for I in 1 .. Element'Length loop    --and check for "
                        if Element(I) = '"' then         --add 1 for doubling
                            Pos := Pos + 1;
                        end if;
                    end loop;
                end;
            else
                Pos := Pos + Length(Item.Element);      --count other items
            end if;


            Pos := Pos + 1;                              --count ','
            Item := Item.Next_Item;
        end loop;
        if List /= null then
            Pos := Pos - 1;                     --remove count for last ','
        end if;
        return Pos;
    end Text_Length;
------------------T E X T - L E N G T H----OF POSITIONAL ITEM---
--
-- Purpose:
-- -------
--     Returns the length of a string representing a list item according
--     to the syntax prescribed in MIL_STD CAIS.  The item is found by
--     position within a list.
--
-- Parameters:
-- ----------
--     List     is the list being examined
--     Position is the position of the item being examined
--     return   the length of the string which is the external text for
--        the item at the designated position
--
-- Exceptions:
-- ----------
--     Use_Error is raised if position is not in range
--
-- Notes: MIL_STD CAIS 5.4.1.13
-- -----
--     None
--
----------------------------------------------------------------

    function Text_Length(List     : in List_Type;
                         Position : in Position_Count) return Natural is
        Pos  : Natural;          --Length to be returned
        Item : List_Type := List; --Item being processed;
    begin
        Find_All(List, Position, Item);
        if Item.Kind = List_Item then
            Pos := Text_Length(Item.List);     --count list
        else
            Pos := Length(Item.Element);       --count item
        end if;

        return Pos;
    end Text_Length;
------------------T E X T - L E N G T H----OF NAMED ITEM--------
--
-- Purpose:
-- -------
--     Returns the length of a string representing a list item according
--     to the syntax prescribed in MIL_STD CAIS.  The item is found by
--     searching for the item name.
--
-- Parameters:
-- ----------
--     List     is the list being examined
--     Named    is the name of the item being examined
--     return   the length of the string which is the external text for
--        the item of the designated name
--
-- Exceptions:
-- ----------
--     Use_Error    is raised if this is an unnamed list
--     Search_Error is raised if a matching name is not found
--
-- Notes: MIL_STD CAIS 5.4.1.13
-- -----
--     None
--
----------------------------------------------------------------

    function Text_Length(List  : in List_Type;
                         Named : in Namestring) return Natural is
        Pos  : Natural;          --Length to be returned
        Item : List_Type := List; --Item being processed;
    begin
        Find(List, Named, Item);
        if Item.Kind = List_Item then
            Pos := Text_Length(Item.List);     --count list
        else
            Pos := Length(Item.Element);       --count item
        end if;

        return Pos;
    end Text_Length;
------------------T E X T - L E N G T H----OF TOKEN_NAMED ITEM-------
--
-- Purpose:
-- -------
--     Returns the length of a string representing a list item according
--     to the syntax prescribed in MIL_STD CAIS.  The item is found by
--     searching for the named token.
--
-- Parameters:
-- ----------
--     List     is the list being examined
--     Named    is the name (in token format) of the item being examined
--     return   the length of the string which is the external text for
--        the item of the designated name
--
-- Exceptions:
-- ----------
--     None
--
-- Notes: MIL_STD CAIS 5.4.1.13
-- -----
--     None
--
----------------------------------------------------------------

    function Text_Length(List  : in List_Type;
                         Named : in Token_Type) return Natural is
    begin
        return Text_Length(List, Retrieve(Named));
    end Text_Length;

----------------------I T E M _ N A M E----PROCEDURE---------------
--
-- Purpose:
-- -------
--     Returns the name of the list item in a named list, specified
--     by position.
--
-- Parameters:
-- ----------
--     List       is the list_type of interest
--     Position   is the position of the item whose name is desired
--     Named      is the Name returned for the item
--
-- Exceptions:
-- ----------
--     Use_Error    is raised if list is positional
--                  or if position exceeds the list length
--
-- Notes: MIL_STD CAIS 5.4.1.14
-- -----
--     Again the CAIS 1.4 semantics are not explicit with respect to
--     null lists. Here, null lists are treated as in Insert, i.e. as
--     either named or positional
--
----------------------------------------------------------------

    procedure Item_Name(List     : in List_Type;
                        Position : in Position_Count;
                        Named    : in out Token_Type) is
        Current    : List_Type; --ptr to desired item in list
        Local_Name : Token_Type;
                                --required because Copy is in out
    begin
        Find_All(List, Position, Current);
        Copy(Local_Name, Current.Name);
        Named := Local_Name;
    end Item_Name;
----------------P O S I T I O N _ B Y _ N A M E----STRING-------
--
-- Purpose:
-- -------
--     Returns the Position at which the given Named is located in the
--     List.  It may only be used with named lists.
--
-- Parameters:
-- ----------
--     List   is the list_type of interest
--     Named  is the Name of the item whose position is desired
--     return the position of the named item
--
-- Exceptions:
-- ----------
--     Use_Error      is raised if List is not named
--     Search_Error   is raised if Named is not in the List
--
-- Notes: MIL_STD CAIS 5.4.1.15
-- -----
--
----------------------------------------------------------------

   -- MIL_STD CAIS 5.4.1.15
    function Position_By_Name(List  : in List_Type;
                              Named : in Namestring) return Position_Count is
        Current : List_Type;  --Ptr to Named item
    begin
        Find(List, Named, Current);
        return Position_Of(List, Current);
    end Position_By_Name;
----------------P O S I T I O N _ B Y _ N A M E----TOKEN_TYPE---
--
-- Purpose:
-- -------
--     Returns the Position at which the given Named is located in the
--     List.  It may only be used with named lists.
--
-- Parameters:
-- ----------
--     List   is the list_type of interest
--     Named  is the Name(in token format) of the item whose position is desired
--     return the position of the named item
--
-- Exceptions:
-- ----------
--     Use_Error      is raised if List is not named
--     Search_Error   is raised if Named is not in the List
--
-- Notes: MIL_STD CAIS 5.4.1.15
-- -----
--
----------------------------------------------------------------
    function Position_By_Name(List  : in List_Type;
                              Named : in Token_Type) return Position_Count is
    begin
        return Position_By_Name(List, Retrieve(Named));
    end Position_By_Name;
---------------------E X T R A C T----NAME --LIS----------------
--
-- Purpose:
-- -------
--     Returns the named List_Element from the list without removing it.
--     Use_Error, Search_Error, indicate unsuccessful extraction.
--
-- Parameters:
-- ----------
--     List      is the named list from which a list_item is to be selected
--     Named     is the name of the item to be copied
--     List_Item is a new list_type consisting of the extacted list
--
-- Exceptions:
-- ----------
--     Search_error     indicates Named item not found
--     Use_Error        indicates an empty or positional list, or that
--                      item is not of list kind.
--
-- Notes: MIL_STD CAIS 5.4.1.16
-- -----
--
-------------------------------------------------------------------

    procedure Extract(List      : in List_Type;
                      Named     : in Namestring;
                      List_Item : in out List_Type) is
        Current    : List_Type;   --ptr too named item
        Local_List : List_Type;   --required because Merge is in out
    begin
        if List = null then
            raise Use_Error;
        else
            Find(List, Named, Current);
            if Current.Kind /= Item_Kind'(List_Utilities.List_Item) then
                raise Use_Error;
            else
                Merge(null, Current.List, Local_List);
                List_Item := Local_List;
            end if;
        end if;
    end Extract;
---------------------E X T R A C T----TOKEN NAME----LIST--------
--
-- Purpose:
-- -------
--     Returns the named List_Element from the list without removing it.
--     Use_Error, Search_Error, indicate unsuccessful extraction.
--
-- Parameters:
-- ----------
--     List      is the named list from which a list_item is to be selected
--     Named     is the name (in token form) of the item to be copied
--     List_Item is a new list_type consisting of the extacted list
--
-- Exceptions:
-- ----------
--     Search_error     indicates Named item not found
--     Use_Error        indicates an empty or positional list
--
-- Notes: MIL_STD CAIS 5.4.1.16
-- -----
--
-------------------------------------------------------------------

    procedure Extract(List      : in List_Type;
                      Named     : in Token_Type;
                      List_Item : in out List_Type) is
    begin
        Extract(List, Retrieve(Named), List_Item);
    end Extract;
---------------------E X T R A C T----POSITIONAL ---------------------
--
-- Purpose:
-- -------
--     Returns the nth List_Element from the positional list without
--     removing it.  Use_Error, Search_Error, imply unsuccessful extraction.
--
-- Parameters:
-- ----------
--     List      is the unnamed list from which a list_item is to be selected
--     Position  is the position of the item to be copied
--     List_Item is a new list_type consisting of the extacted list
--
-- Exceptions:
-- ----------
--     Use_Error        indicates an empty or positional list
--                      or indicates Position exceeds list length
--
-- Notes: MIL_STD CAIS 5.4.1.16
-- -----
--
----------------------------------------------------------------

    procedure Extract(List      : in List_Type;
                      Position  : in Position_Count;
                      List_Item : in out List_Type) is
        Current    : List_Type;   --ptr too named item
        Local_List : List_Type;   --required because merge is in out
    begin
        if List = null then
            raise Use_Error;
        else
            Find_All(List, Position, Current);
            if Current.Kind /= Item_Kind'(List_Utilities.List_Item) then
                raise Use_Error;
            else
                Merge(null, Current.List, Local_List);
                List_Item := Local_List;
            end if;
        end if;
    end Extract;
--------------------R E P L A C E-----POSITIONAL--------------------
--
-- Purpose:
-- -------
--     Replaces an item in a positional list.  The new item
--     must be of the same item kind as the one being replaced.
--
-- Parameters:
-- ----------
--     List       is the unnamed list of interest
--     List_Item  is the value of list_type which will replace an item in list
--     Position   is the position of a list_item in list which will be replaced
--
-- Exceptions:
-- ----------
--     Use_Error     is raised if position exceeds list length.
--                   or if item kinds do not match.
--
-- Notes: MIL_STD CAIS 5.4.1.17
-- -----
--
----------------------------------------------------------------

    procedure Replace(List      : in out List_Type;
                      List_Item : in List_Type;
                      Position  : in Position_Count) is
        Current : List_Type;   --ptr to list element being modified
    begin
        Find_All(List, Position, Current);
        if Current.Kind = List_Utilities.List_Item then --enumeration
            Merge(null, List_Item, Current.List);            --in parameter
        else
            raise Use_Error;
        end if;
    end Replace;
--------------------R E P L A C E-----NAMED-------------------------
--
-- Purpose:
-- -------
--     Replaces an item in a named list.  The new item
--     must be of the same item kind as the one being replaced.
--
-- Parameters:
-- ----------
--     List       is the named list of interest
--     List_Item  is the value of list_type which will replace an item in list
--     Named      is the name of a list_item in list which will be replaced
--
-- Exceptions:
-- ----------
--     Use_Error        is raised if item kinds do not match.
--     Search_Error     is raised if Named item is not found.
--
-- Notes: MIL_STD CAIS 5.4.1.17
-- -----
--
----------------------------------------------------------------

    procedure Replace(List      : in out List_Type;
                      List_Item : in List_Type;
                      Named     : in Namestring) is
        Current : List_Type;       --ptr to list element being modified
    begin
        Find(List, Named, Current);
        if Current.Kind = Item_Kind'(List_Utilities.List_Item) then
                                                        --enumeration
            Merge(null, List_Item, Current.List);       --parameter
        else
            raise Use_Error;
        end if;
    end Replace;
--------------------R E P L A C E-----NAMED----TOKEN----------------
--
-- Purpose:
-- -------
--     Replaces an item in a named list.  The new item
--     must be of the same item kind as the one being replaced.
--
-- Parameters:
-- ----------
--     List       is the named list of interest
--     List_Item  is the value of list_type which will replace an item in list
--     Named      is the name (in token format) of a list_item in list which
--                will be replaced
--
-- Exceptions:
-- ----------
--     Use_Error        is raised if item kinds do not match.
--     Search_Error     is raised if Named item is not found.
--
-- Notes: MIL_STD CAIS 5.4.1.17
-- -----
--
----------------------------------------------------------------

    procedure Replace(List      : in out List_Type;
                      List_Item : in List_Type;
                      Named     : in Token_Type) is
    begin
        Replace(List, List_Item, Retrieve(Named));
    end Replace;
-----------------I N S E R T----POSITIONAL----------------------
-- Purpose:
-- -------
--     Inserts a list item into a positional list.  Use_Error or Search_Error
--     may be raised indicating list item has not been inserted.
--
-- Parameters:
-- ----------
--     List       is the list_type of interest
--     List_Item  is the value to be added to list as a list_item
--     Position   is the position in list after which List_Item will be placed
--
-- Exceptions:
-- ----------
--     Use_Error     is raised if this is a named list.
--                   or if position exceeds size of list
--
-- Notes: MIL_STD CAIS 5.4.1.18
-- -----
----------------------------------------------------------------
    procedure Insert(List      : in out List_Type;
                     List_Item : in List_Type;
                     Position  : in Count) is
        Current  : List_Type;       --ptr to list item to insert after
        New_Item : List_Type;       --ptr to area where new list item is built
    begin
        if Position /= 0 then
            Find(List, Position, Current);
        elsif List /= null and then List.Name /= null then
            raise Use_Error;          --Mixed Named/Positional Items
        end if;
        New_Item := new Item_Descriptor;

        --store value fields
        New_Item.Name := null;
        New_Item.Kind := Item_Kind'(List_Utilities.List_Item);
                                                --enumeration
        New_Item.List := List_Item;             --parameter

        --now set up pointers
        if Position /= 0 then
            New_Item.Next_Item := Current.Next_Item;     --simple item
            Current.Next_Item := New_Item;
        else
            New_Item.Next_Item := List;                  --head item
            List := New_Item;
        end if;
    end Insert;
-----------------I N S E R T----NAMED---STRING------------------
-- Purpose:
-- -------
--     Inserts a list item into a named list.  Use_Error or Search_Error
--     may be raised indicating list item has not been inserted.
--
-- Parameters:
-- ----------
--     List       is the list_type of interest
--     List_Item  is the value to be added to list as a list_item
--     Named      is the string value of the name to be used for List-Item
--     Position   is the position in list after which List_Item will be placed
--
-- Exceptions:
-- ----------
--     Use_Error     is raised if this is an unnamed list.
--                   or if position exceeds size of list
--
-- Notes: MIL_STD CAIS 5.4.1.18
-- -----
----------------------------------------------------------------
    procedure Insert(List      : in out List_Type;
                     List_Item : in List_Type;
                     Named     : in Namestring;
                     Position  : in Count) is
        Current  : List_Type;      --ptr to list item to insert after
        New_Item : List_Type;      --ptr to area where new list item is built
        Token    : Token_Type;     --Name converted for Name_check
    begin
        if Position /= 0 then
            Find_All(List, Position, Current);
        end if;
        if List /= null and then List.Name = null then
            raise Use_Error;          --Mixed Named/Positional Items
        end if;
        Identifier_Items.To_Token(Named, Token);
        Name_Check(List, Token);        --Use_Error, if duplicate name
        New_Item := new Item_Descriptor;

        --store value fields
        Validate_Item(Named, Identifier_Item, New_Item.Name);
        New_Item.Kind := List_Utilities.List_Item;   --enumeration
        New_Item.List := List_Item;                          --parameter

        --now set up pointers
        if Position /= 0 then
            New_Item.Next_Item := Current.Next_Item;     --simple item
            Current.Next_Item := New_Item;
        else
            New_Item.Next_Item := List;                  --head item
            List := New_Item;
        end if;
    end Insert;
-----------------I N S E R T----NAMED---TOKEN-------------------
--
-- Purpose:
-- -------
--     Inserts a list item into a named list.  Use_Error
--     or Search_Error may be raised indicating list item has
--     not been inserted.
--
-- Parameters:
-- ----------
--     List       is the list_type of interest
--     List_Item  is the value to be added to list as a list_item
--     Named      is the name value (in token form) to be used for List-Item
--     Position   is the position in list after which List_Item will be placed
--
-- Exceptions:
-- ----------
--     Use_Error     is raised if this is an unnamed list.
--                   or if position exceeds size of list
--
-- Notes: MIL_STD CAIS 5.4.1.18
-- -----
--
----------------------------------------------------------------

    procedure Insert(List      : in out List_Type;
                     List_Item : in List_Type;
                     Named     : in Token_Type;
                     Position  : in Count) is
    begin
        Insert(List, List_Item, Retrieve(Named), Position);
    end Insert;
-----------P O S I T I O N _ B Y _ V A L U E--------------------
--
-- Purpose:
-- -------
--     Returns the position at which the next list_type item of the given
--     value is located. the search begins at the Start_Position and ends
--     when either an item of Value is found, the last item of the list
--     has been examined, or the item at the End_Position has been
--     examined, whichever comes first.
--
-- Parameters:
-- ----------
--     List           is the list_type of interest
--     Value          is the value of list_type being looked for
--     Start_Position is the position of the starting item in the search
--     End_Position   is the position of the ending   item in the search
--     return         the position of an item whose value matches
--
-- Exceptions:
-- ----------
--     Use_Error     raised if Start<End or Start > length of list
--     Search_Error  raised if Value not found in specified range
--
-- Notes: MIL_STD CAIS 5.4.1.19
-- -----
--
----------------------------------------------------------------

  --MIL_STD CAIS 5.4.1.19
    function Position_By_Value(List           : in List_Type;
                               Value          : in List_Type;
                               Start_Position : in Position_Count :=
                                   Position_Count'First;
                               End_Position   : in Position_Count :=
                                   Position_Count'Last) return Position_Count
        is
        Pos     : Position_Count := 1;
        Current : List_Type := List;

    begin
        if Start_Position > End_Position then   --Valid Range??
            raise Use_Error;
        end if;

        while Pos < Start_Position loop         --Move to Start
            if Current = null then                  --End of list
                raise Use_Error;
            end if;

            Pos := Pos + 1;
            Current := Current.Next_Item;
        end loop;

        while Pos <= End_Position loop          --Check each item in range
            if Current = null then                  --End of List?
                raise Search_Error;
            end if;

            if Current.Kind = List_Item and then Is_Equal(Current.List, Value)
                then
                return Pos;                         --Match found
            end if;

            Pos := Pos + 1;
            Current := Current.Next_Item;
        end loop;

        raise Search_Error;                             --!!!No match
    end Position_By_Value;


--------------------------------------------------------------------------
--   S E P A R A T E     P A C K A G E   I D E N T I F I E R _ I T E M
--MIL_STD CAIS 5.4.1.20
--------------------------------------------------------------------------
    package body Identifier_Items is separate;




--------------------------------------------------------------------------
--   S E P A R A T E     P A C K A G E   S T R I N G _ I T E M
--MIL_STD CAIS 5.4.1.23
--------------------------------------------------------------------------
    package body String_Items is separate;




end List_Utilities;  -- body
--::::::::::::::
--magnetic_tape_body.a
--::::::::::::::
separate(Cais)
package body Magnetic_Tape is
    use Node_Definitions;
    use Io_Definitions;


    procedure Mount(Tape_Drive : File_Type;
                    Tape_Name  : Reel_Name;
                    Density    : Positive) is
    begin
        Trace.Assert_Fatal(False, "Mount is NOT implemented");
    end Mount;

    procedure Load_Unlabeled(Tape_Drive : File_Type;
                             Density    : Positive;
                             Block_Size : Positive) is
    begin
        Trace.Assert_Fatal(False, "Load_Unlabeled is NOT implemented");
    end Load_Unlabeled;

    procedure Initialize_Unlabeled(Tape_Drive : File_Type;
                                   Density    : Positive;
                                   Block_Size : Positive) is
    begin
        Trace.Assert_Fatal(False, "Initialize_Unlabeled is NOT implemented");
    end Initialize_Unlabeled;

    procedure Load_Labeled(Tape_Drive        : File_Type;
                           Volume_Identifier : Volume_String;
                           Density           : Positive;
                           Block_Size        : Positive) is
    begin
        Trace.Assert_Fatal(False, "Load_Labeled is NOT implemented");
    end Load_Labeled;

    procedure Initialize_Labeled(Tape_Drive        : File_Type;
                                 Volume_Identifier : Volume_String;
                                 Density           : Positive;
                                 Block_Size        : Positive;
                                 Accessibility     : Character := ' ') is
    begin
        Trace.Assert_Fatal(False, "Initialize_Labeled is NOT implemented");
    end Initialize_Labeled;

    procedure Unload(Tape_Drive : File_Type) is
    begin
        Trace.Assert_Fatal(False, "Unload is NOT implemented");
    end Unload;

    procedure Dismount(Tape_Drive : File_Type) is
    begin
        Trace.Assert_Fatal(False, "Dismount is NOT implemented");
    end Dismount;

    function Is_Loaded(Tape_Drive : File_Type) return Boolean is
    begin
        Trace.Assert_Fatal(False, "Is_Loaded is NOT implemented");
        return (False);
    end Is_Loaded;

    function Is_Mounted(Tape_Drive : File_Type) return Boolean is
    begin
        Trace.Assert_Fatal(False, "Is_Mounted is NOT implemented");
        return (False);
    end Is_Mounted;

    function Tape_Status(Tape_Drive : File_Type) return Tape_Position is
    begin
        Trace.Assert_Fatal(False, "Tape_Status is NOT implemented");
        return Other;
    end Tape_Status;

    procedure Rewind_Tape(Tape_Drive : File_Type) is
    begin
        Trace.Assert_Fatal(False, "Rewind_Tape is NOT implemented");
    end Rewind_Tape;

    procedure Skip_Tape_Marks(Tape_Drive : File_Type;
                              Number     : Integer := 1;
                              Tape_State : in out Tape_Position) is
    begin
        Trace.Assert_Fatal(False, "Skip_Tape_Marks is NOT implemented");
    end Skip_Tape_Marks;

    procedure Write_Tape_Mark(Tape_Drive : File_Type;
                              Number     : Positive := 1;
                              Tape_State : in out Tape_Position) is
    begin
        Trace.Assert_Fatal(False, "Write_Tape_Mark is NOT implemented");
    end Write_Tape_Mark;

    procedure Volume_Header(Tape_Drive        : File_Type;
                            Volume_Identifier : Volume_String;
                            Accessibility     : Character := ' ') is
    begin
        Trace.Assert_Fatal(False, "Volume_Header is NOT implemented");
    end Volume_Header;

    procedure File_Header(Tape_Drive      : File_Type;
                          File_Identifier : File_String;
                          Expiration_Date : String := " 99366";
                          Accessibility   : Character := ' ') is
    begin
        Trace.Assert_Fatal(False, "File_Header is NOT implemented");
    end File_Header;

    procedure End_File_Label(Tape_Drive : File_Type) is
    begin
        Trace.Assert_Fatal(False, "End_File_Label is NOT implemented");
    end End_File_Label;

    procedure Read_Label(Tape_Drive : File_Type;
                         Label      : in out Label_String) is
    begin
        Trace.Assert_Fatal(False, "Read_Label is NOT implemented");
    end Read_Label;


end Magnetic_Tape;
--::::::::::::::
--node_get_next.a
--::::::::::::::


----------------------------------------------------------------------
--                         G E T _ N E X T
--           (Separate Procedure from Package Node_Management)
--
--            Returns node handle to next node in an iterator
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Wed Oct  9 15:01:37 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------          Get_Next       ----------------------
--
--  Purpose: Returns an open node handle to the next node in the iterator.
--  -------  If Next_Node is open prior to the call to Get_Next, it is
--         closed prior to being opened for the next node. Intent and
--         Time_Limit specify conditions under which Next_Node is opened.
--
--  Parameters:
--  ----------
--    Iterator   is a previously constructed node iterator.
--    Next_Node  is the node handle to be opened for the iterator's next node
--    Intent     is the intent with which Next_Node is to be opened
--    Time_Limit specifies the delay on waiting for the unlocking of the node
--               in accordance with the desired intent.
--
--  Exceptions:
--  ----------
--    Name_Error is raised if the node whose handle is to be returned is
--        unobtainable and the intent specified is other than Existence.
--
--    Use_Error is raised if the Iterator has not been previously set by the
--        procedure Iterate, or if the iterator is exhausted, i.e.,
--        More(Iterator) = false, or if Intent is an empty array.
--
--    Lock_Error is raised if the opening of the node handle is delayed beyond
--        the specified Time_Limit due to the existence of locks in conflict
--        with the specified intent.
--
--    Access_Violation is raised if the current process discretionary control
--        rights are insufficient to obtain access to the next node with the
--        specified intent.  Access_Violation is raised only if the conditions
--        for Name_Error are not present.
--
--    Security_Violation is raised if the current process' attempt to obtain
--        access to the next node with the specified Intent represents a
--        violation of mandatory access controls for the CAIS.  Security_
--        Violation is raised only if the conditions for other exceptions are
--        not present.
--
--  Notes:CAIS 5.1.3.13
--  -----
--
--  Revision History
--  ----------------
--    12-04-85    Removed references to V_String which is now hidden.
--            We now use Identifier_Items.To_Text(xx).
---------------------------------------------------------------------
separate(Cais.Node_Management)
procedure Get_Next(   -- get open node handle to next node  in iterator
                   Iterator   : in out Node_Iterator;
                                      -- see CAIS 1.4 5.1.2.25 for expl.
                   Next_Node  : in out Node_Type;
                                          -- will be the open node handle
                   Intent     : in Intention := (1 => Existence);
                                                 --intent for opening
                   Time_Limit : in Duration := No_Delay)
                                                 --time limit for opening
is

    use Iterator_Support;

    Value         : List_Type;                  --List of valid keys
    Relation_Name : Token_Type;
    Key_Name      : Token_Type;

begin
    if Iterator.Rel_Position < 0 or else                                --Poorly formed
    Iterator.List = null or else Iterator.Rel_Position > Length(Iterator.List.
        all) then
        raise Node_Definitions.Use_Error;

    else                                                        --get next Key
        Iterator.Key_Position := Iterator.Key_Position + 1;
        Extract(Iterator.List.all, Iterator.Rel_Position, Value);

        if Iterator.Rel_Position = Length(Iterator.List.all) and then Iterator.
            Key_Position > Length(Value) then
            raise Node_Definitions.Use_Error;                   --Exhausted
        end if;

        if Iterator.Key_Position > Length(Value) then             --new relation
            Iterator.Rel_Position := Iterator.Rel_Position + 1;
            Iterator.Key_Position := 1;
            Extract(Iterator.List.all, Iterator.Rel_Position, Value);
        end if;

        Item_Name(Iterator.List.all, Iterator.Rel_Position, Relation_Name);
        Item_Name(Value, Iterator.Key_Position, Key_Name);

      -- close node, if it is already open
        if Is_Open(Next_Node) then
            Close(Next_Node);
        end if;

      -- build a pathname from the base, relation, and key...
        Open(Next_Node, Iterator.Base_Name(1 .. Iterator.Base_Name_Length) & "'"
            & Identifier_Items.To_Text(Relation_Name) & "(" & Identifier_Items.
            To_Text(Key_Name) & ")", Intent, Time_Limit);

    end if;
end Get_Next;
--::::::::::::::
--node_internals_body.a
--::::::::::::::

----------------------------------------------------------------------
--                    N O D E _ I N T E R N A L S
--                          (Package Body)
--
--
--             Services to Work With CAIS Pathnames and
--                    The Implementation of Nodes
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Mon May 20 13:58:36 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
----------------------------------------------------------------------
--
--  Purpose:
--  -------
--      This package provides services to work with CAIS pathnames
--      and to support the implementation of CAIS nodes.
--
--  Usage:
--  -----
--    TBS
--
--  Example:
--  -------
--    TBS
--
--  Notes:
--  -----
--
--  Revision History:
--  ----------------
--
-------------------------------------------------------------------
with Trace;
with Character_Set; use Character_Set;
with Generic_Stack;

separate(Cais)
package body Node_Internals is

    use Pragmatics;
    use Cais_Internals_Exceptions;

    type Pathname(Size : Natural) is
        record
            Str_Buf : String(1 .. Size);
                                    -- String Buffer for Pathname image
            Index   : Natural := 1; -- Offset of current char in Str_Buf
        end record;


    type Parse_Symbol is (Element_Set, Path_Element, Relation_Name,
        Paren_Relationship_Key, Relationship_Key,

    Identifier, Sharp, Colon, Left_Paren, Right_Paren, Tic, Dot, Other,
        End_Of_Pathname);

    subtype Token_Class is Parse_Symbol range Identifier .. End_Of_Pathname;

    package Symbol_Stack is
        new Generic_Stack(Parse_Symbol);
    use Symbol_Stack;


    type Token is
        record
            Value     : String(1 .. Pragmatics.Max_Token_Size) := (others => ' '
                );               -- Token image
            Class     : Token_Class;
            Last_Char : Natural;
                             -- offset of last char of image in Value
        end record;

----------------------  C O N V E R T _ T O _ P N -------------------
--
--  Purpose:
--  -------
--    This function converts a string containing a path to a pathname.
--
--  Parameters:
--  ----------
--    Name - string containing the path to be converted..
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------

    function Convert_To_Pn(Name : Node_Definitions.Name_String) return Pathname
        is

        Path : Pathname(Name'Length);
    begin
        Path.Str_Buf := Name;
        return Path;
    exception
        when others =>
            Trace.Report("*** Unhandled exception in Convert_To_Pn ***");
            raise Trace.Assertion_Violation;
    end Convert_To_Pn;

----------------------   S K I P _ W H I T E S P A C E --------------
--
--  Purpose:
--  -------
--    This procedure advances the index in a pathname past any
--    whitespace (blanks, tabs).
--
--  Parameters:
--  ----------
--    Name - the pathname to be updated.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------

    procedure Skip_Whitespace(Name : in out Pathname) is

    begin
        for I in Name.Index .. Name.Size loop
            if Name.Str_Buf(I) /= ' ' and Name.Str_Buf(I) /= Ascii.Ht then
                Name.Index := I;
                return;
            end if;
        end loop;
        -- if control gets here, there were no more non-blank
        -- characters in the pathname.  Set Index past end of pathname
        -- so that Get_Next_Token knows it is at end of pathname.
        Name.Index := Name.Size + 1;
        return;

    exception
        when others =>
            Trace.Report("Unhandled exception in Skip_Whitespace");
            raise Trace.Assertion_Violation;
    end Skip_Whitespace;


    procedure Get_Identifier(Path : in out Pathname;
                             Id   : in out Token) is separate;



    procedure Get_Next_Token(From : in out Pathname;
                             Next : in out Token) is separate;



    procedure Get_Parsed_Pn(Name   : Node_Definitions.Name_String;
                            Result : in out Parsed_Pn) is separate;

------------------- P N _ C O M P O N E N T _ C O U N T -------------
--
--  Purpose:
--  -------
--    This function returns the number of distinct pathname components
--    (i.e. pathname elements) in the given parsed pathname.
--
--  Parameters:
--  ----------
--    Pn - the parsed pathname to be examined.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------

    function Pn_Component_Count(Pn : Parsed_Pn) return Natural is

    begin
        return Node_Representation.Pn_Comp_List.Last_Index(Pn.L);
    exception
        when others =>
            Trace.Report("Unhandled exception in Pn_Component_Count");
            raise Trace.Assertion_Violation;
    end Pn_Component_Count;



--------------------  G E T _ P N _ C O M P O N E N T ---------------
--
--  Purpose:
--  -------
--    This procedure extracts the data associated with a specific
--    pathname component (i.e. pathname element).
--
--  Parameters:
--  ----------
--    Pn         - parsed pathname to be examined
--    Index      - offset of path element to be examined
--    Rel_Name   - Relation name of this path element
--    Rel_Key    - Relationship Key of this path element
--    Latest_Rel - boolean indicating if the relationship key
--                 ends with the latest key character (#)
--
--  Exceptions:
--  ----------
--    No_Such_Component - raised if "Index" does not refer to
--                        an existing component in the pathname.
--
--  Notes:
--  -----
--
---------------------------------------------------------------------

    procedure Get_Pn_Component(Pn         : Parsed_Pn;
                               Index      : Positive;
                               Rel_Name   : in out String;
                               Rel_Key    : in out String;
                               Latest_Rel : in out Boolean) is

        Tmp_Rec : Pn_Rec;

    begin

        -- Set_Current_Index returns True if OK,
        -- False if Index is too large
        if not Node_Representation.Pn_Comp_List.Set_Current_Index(Pn.L, Index)
            then
            raise No_Such_Component;
        end if;

        Tmp_Rec := Node_Representation.Pn_Comp_List.Return_Current_Element(Pn.L)
            ;
        Rel_Name := Tmp_Rec.Rel_Name(Tmp_Rec.Rel_Name'First .. Last_Non_Space(
            Tmp_Rec.Rel_Name));
        Rel_Key := Tmp_Rec.Rel_Key(Tmp_Rec.Rel_Key'First .. Last_Non_Space(
            Tmp_Rec.Rel_Key));
        Latest_Rel := Tmp_Rec.Latest_Key;

    exception
        when No_Such_Component =>
            raise;
        when others =>
            Trace.Report("Unhandled exception in Get_Pn_Component");
            raise Trace.Assertion_Violation;
    end Get_Pn_Component;


    procedure Create_Node(Node                 : in out Node_Type;
                          Base                 : in out Node_Type;
                          Kind                 : Node_Kind;
                          Internals_Attributes : List_Type;
                          User_Attributes      : List_Type;
                          Internals_Relations  : List_Type;
                          Intent               : Intention;
                          Access_Control       : List_Type;
                          Level                : List_Type;
                          Key                  : String;
                          Relation             : String) is separate;

    procedure Read_Shadow_File(Node : in out Node_Type) is separate;

    procedure Write_Shadow_File(Node : Node_Type) is separate;

end Node_Internals;
--::::::::::::::
--node_iterate.a
--::::::::::::::


----------------------------------------------------------------------
--                          I T E R A T E
--              (Separate Procedure From Node_Management)
--
--      Creates node iterators given base, relation and key pattern
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Thu Oct 10 07:55:05 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------
--------------------------ITERATE-------------------------------------
--
--  Purpose:  Creates a set of nodes from the named node which match the
--  -------   provided key and relation patterns containing wild card
--            characters '*' to match any string and '?' to match any
--            character.
--
--  Parameters:
--  ----------
--   Iterator is the set of matching attributes
--   Node     is the node whose relationships are searched for matches
--   Kind     is the kind of nodes to include in the iterator
--   Key      is the string (with * and ?) which determines key matches
--   Relation is the string (with * and ?) which determines relation matches
--   Primary_Only  is a flag requesting only primary relationships be searched
--
--  Exceptions:
--  ----------
--   Use_Error        is raised if the Pattern in Key or Relation is
--              syntactically illegal
--
--   Status_Error     is raised if the node is not an open node handle
--
--   Intent_Violation is rasied if Node is not open with the right to
--              read relationships.
--
--  Notes:
--  -----
--    CAIS 5.1.2.26
--
--  Change History:
--  --------------
--    01-08-86    Added checks for Kind and for Primary_Only
---------------------------------------------------------------------
separate(Cais.Node_Management)
procedure Iterate(        -- build an iterator
                  Iterator     : in out Node_Iterator;
                                          -- see CAIS 1.4 5.1.2.25 for expl.)
                  Node         : in Node_Type;    -- open node handle for desired node
                  Kind         : in Node_Kind;
                                          -- kind of nodes to include
                  Key          : in Relationship_Key_Pattern := "*";
                                          -- pattern to select keys
                  Relation     : in Relation_Name_Pattern := Default_Relation;
                                          -- pattern to select relations
                  Primary_Only : in Boolean := True) is

    use Iterator_Support;
    use Identifier_Items;

    Relation_List : List_Type;
    Relation_Name : Token_Type;
    Relation_Size : Integer := 0;
    Key_List      : List_Type;
    Key_Name      : Token_Type;
    Key_Size      : Integer := 0;
    It_Key_List   : List_Type;

    Rel_Attr      : List_Type;
    Primary       : Boolean;
    Shadow_File   : String(1 .. Max_Shadow_File_Length);


    function Kind_Matches(Rel_Attr : List_Type;
                          Kind     : Node_Kind) return Boolean is
        Kind_Value : List_Type;
        Kind_List  : List_Type;
        Pos        : Position_Count;
    begin
        Extract(Rel_Attr, "Kind", Kind_Value);
        String_To_Simple_List(Node_Kind'Image(Kind), Kind_List);
        if Is_Equal(Kind_Value, Kind_List) then
            return True;
        else
            return False;
    end if;
    end Kind_Matches;


begin
    Verify_Pattern(Relation, Relation_Size);                    --Use_Error check
    Verify_Pattern(Key, Key_Size);                      --Use_Error check
    if not Is_Open(Node) then                           --Status_Error check
        raise Node_Definitions.Status_Error;
    end if;
    Check_Intentions(Node, Read_Relationships);         --Intent check
    Get_Node_Relations(Node, Relation_List);

                                                        --Initialize Iterator
    Iterator.List := new List_Type;
    Iterator.Rel_Position := 1;
    Iterator.Key_Position := 0;
    Get_Pathname(Node, Iterator.Base_Name, Iterator.Base_Name_Length);
    Copy(Iterator.List.all, Empty_List);

    for I in 1 .. Length(Relation_List) loop
        Item_Name(Relation_List, I, Relation_Name);
        if Pattern_Match(To_Text(Relation_Name), Relation(Relation'First ..
            Relation_Size)) then

            Extract(Relation_List, I, Key_List);        --Relation matches, now
            for J in 1 .. Length(Key_List) loop         --check all keys
                Item_Name(Key_List, J, Key_Name);
                if Pattern_Match(To_Text(Key_Name), Key(Key'First .. Key_Size))
                    then

                  --Match!!  First check that Node kind is valid
                  --and that Primary_Only is satified
                    Get_A_Relationship(Node, To_Text(Relation_Name), To_Text(
                        Key_Name), Shadow_File, Rel_Attr, Primary);
                    if Kind_Matches(Rel_Attr, Kind) and then ((not Primary_Only)
                        or Primary) then

                    --Add Relation and Key to iterator
                    --If this relation is already in the iterator
                    --just add Key to its list.  Otherwise create
                    --list with just this key and add this relation
                    --to the iterator
                        begin
                            Extract(Iterator.List.all, Relation_Name,
                                It_Key_List);
                        exception
                            when Search_Error | Node_Definitions.Use_Error =>
                                Copy(It_Key_List, Empty_List);
                                Insert(Iterator.List.all, It_Key_List,
                                    Relation_Name, Lexical_Position(Iterator.
                                    List.all, Relation_Name));
                        end;
                        Insert(It_Key_List, Key_Name, Key_Name, Lexical_Position
                            (It_Key_List, Key_Name));
                        Replace(Iterator.List.all, It_Key_List, Relation_Name);
                    end if;
                         -- Primary and kind tests pass
                end if;   --relation and key match
            end loop;       --check all keys
        end if;                       --relation matches
    end loop;                    --check all relations
end Iterate;
--::::::::::::::
--node_management_body.a
--::::::::::::::

----------------------------------------------------------------------
--             C A I S _ N O D E _ M A N A G E M E N T
--                         (Package Body)
--
--
--       Primitives For Manipulating Nodes and Their Relationships
--
--
--
--
--
--                  Ada Software Engineering Group
--                      The MITRE Corporation
--                         McLean, VA 22102
--
--
--                   Thu Sep 12 14:30:13 EDT 1985
--
--                 (Unclassified and uncopyrighted)
--
----------------------------------------------------------------------

with Str_Pack; use Str_Pack;
with Character_Set; use Character_Set;
with Text_Io;

separate(Cais)
package body Node_Management is

    use Standard.Text_Io;
    use Node_Internals;
    use Node_Representation;
    use Cais_Utilities;
    use Cais_Internals_Exceptions;
    use Cais_Host_Dependent;
    use Trace;


------------------------       O P E N       ------------------------
--
--  Purpose:
--  -------
--    These procedure return an open node handle in "Node" to the
--    node identified by the pathname "Name" or "Base"/"Key"/"Relation",
--    respectively.
--
--  Parameters:
--  ----------
--    Node      - a node handle, initially closed, to be opened to the
--                identified node
--    Name      - the pathname identifying the node to be opened
--    Base      - open node handle to a base node for identification
--    Key       - the relationship key for node identification
--    Relation  - the relation name for node identification
--    Intent    - the intent of subsequent operations on the node; the
--                actual parameter takes the form of an array aggregate
--    Time_Limit - specifies time limit for the delay on waiting for the
--                unlocking of a node in accordance with the desired intent
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the pathname specified by "Name" is
--                        syntactically illegal or if any traversed node
--                        in the path specified by pathname is unobtainable,
--                        inaccessible, or non-existant, or if the relationship
--                        specified by "Relation" and "Key" or by the last
--                        path element of "Name" does not exist.  Name_Error
--                        is also raised if the node to which a handle is to
--                        be opened is inaccessible or unobtainable and the
--                        given "Intent" includes any intent other
--                        than "Existence".
--    Use_Error         - is raised if the specified intent is an empty array.
--    Status_Error      - is raised if the Node_Handle "Node" is already
--                        open prior to the call on Open or if Base is not
--                        an open node handle.
--    Lock_Error        - is raised if the Open operation is delayed beyond
--                        the specified time limit due to the existance of
--                        locks in conflict with the specified Intent.  This
--                        includes any delays caused by locks on nodes
--                        traversed on the path specified by the pathname
--                        "Name", or locks on the node identified by "Base",
--                        preventing the reading of relationships emanating
--                        from these nodes.
--    Intent_Violation  - is raised if "Base" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to traverse
--                        the path specified by "Name" or by "Base", "Key",
--                        and "Relation" or to obtain access to the node
--                        consistent with the specified intent.
--                        Access_Violation is raised only if the conditions
--                        for Name_Error are not present.
--    Security_Violation -is raised if the attempt to obtain access to the
--                        node with the specified intent represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.1
--  -----
--
---------------------------------------------------------------------

    use Character_Set;

    procedure Open(Node       : in out Node_Type;
                   Name       : Node_Definitions.Name_String;
                   Intent     : Intention := (1 => Read);
                   Time_Limit : Duration := No_Delay) is

        use Cais_Host_Dependent;
        use List_Utilities;
        use Trace;

        Pn            : Node_Representation.Parsed_Pn;
        Rel_Name      : String(1 .. Max_Relationship_Name) := (others => ' ');
        Rel_Key       : String(1 .. Max_Relationship_Key) := (others => ' ');
        Path_Elements : Natural;
        Shadow_File   : String(1 .. Max_Shadow_File_Length);
        Attributes    : List_Type;
        Primary       : Boolean;
        Latest_Key    : Boolean;
        Shadow_Length : Natural;

    begin

        if Intent'Length = 0 then
            raise Node_Definitions.Use_Error;
        end if;
        if Open_Status(Node) then
            raise Node_Definitions.Status_Error;
        end if;

        Get_Parsed_Pn(Name, Pn);
        Path_Elements := Node_Internals.Pn_Component_Count(Pn);

    -- Begin navigating pathname from current process
        Set_Shadow_File_Name(Node, Cais_Host_Dependent.
            Current_Process_Shadow_File);
        Node_Internals.Read_Shadow_File(Node);
        Get_Pn_Component(Pn, 1, Rel_Name, Rel_Key, Latest_Key);
        Get_A_Relationship(Node, Rel_Name, Rel_Key, Shadow_File, Attributes,
            Primary);

    -- Now navigate the pathname components to the last element
        for Index in 2 .. Path_Elements loop
            Set_Shadow_File_Name(Node, Shadow_File);
            Rel_Name := (others => ' ');
            Rel_Key := (others => ' ');
            Shadow_File := (others => ' ');
            Get_Pn_Component(Pn, Index, Rel_Name, Rel_Key, Latest_Key);
            Node_Internals.Read_Shadow_File(Node);
            Get_A_Relationship(Node, Rel_Name, Rel_Key, Shadow_File, Attributes
                , Primary);
        end loop;

    -- Shadow_File now contains the name of the shadow file for the
    -- last pathname element; the values in this shadow file are
    -- returned in the opened node handle.
    -- This call to Read_Shadow_File is associated with its own
    -- exception handler, in case the shadow file does not exist
    -- and the Intent was only for existence.


        Set_Shadow_File_Name(Node, Shadow_File);

        Existence_Check : begin
          -- block for exception handler
            Node_Internals.Read_Shadow_File(Node);
        exception
            when No_Such_Shadow_File =>
            -- if the only intent for this open was Existence,
            -- return an open node handle; otherwise, raise a Name_Error
                for I in Intent'range loop
                    if Intent(I) /= Existence then
                        raise Node_Definitions.Name_Error;
                    end if;
                end loop;
            when others =>
                raise;
        end Existence_Check;

    -- First check that we aren't about to allow the user to
    -- access the system node via CAIS interfaces...
        Shadow_Length := Character_Set.Last_Non_Space(Shadow_File);
        if Shadow_File(1 .. Shadow_Length) = Cais_Host_Dependent.
            Cais_System_Node then
        -- CAIS Spec 4.3.4.2(3) prohibits direct access to the
        -- System_Node. presumably this means that an attempt to
        -- Open it is an attempt to Open an inaccessible node, hence
        -- a Name_Error is raised by Open.
            raise Node_Definitions.Name_Error;
        end if;

        Set_Open(Node, True);
        Set_Intent(Node, Intent);
        Set_Pathname(Node, Name);

    exception
    -- exceptions that are trapped (nothing propagated)
        -- NONE
    -- exceptions that are propagated
        when Node_Definitions.Name_Error | Node_Definitions.Use_Error |
            Node_Definitions.Lock_Error | Node_Definitions.Status_Error |
            Node_Definitions.Intent_Violation | Node_Definitions.
            Access_Violation | Node_Definitions.Security_Violation =>
            raise;
    -- exceptions that are mapped to other exceptions
        when Pathname_Syntax_Error | No_Such_Relation | No_Such_Relationship |
            No_Such_Shadow_File =>
            raise Node_Definitions.Name_Error;
    -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Node_Management.Open ");
            raise;
    -- unanticipated exceptions
        when others =>
            Trace.Report("UNANTICIPATED EXCEPTION in Node_Management.Open ");
            raise Trace.Assertion_Violation;

    end Open;

    procedure Open(Node       : in out Node_Type;
                   Base       : Node_Type;
                   Key        : Relationship_Key;
                   Relation   : Relation_Name := Default_Relation;
                   Intent     : Intention := (1 => Read);
                   Time_Limit : Duration := No_Delay) is

        Attributes    : List_Utilities.List_Type;
        Primary       : Boolean;
        Shadow_File   : String(1 .. Max_Shadow_File_Length);
        Shadow_Length : Natural;

    begin
        if Intent'Length = 0 then
            raise Node_Definitions.Use_Error;
        end if;
        if Open_Status(Node) or not Open_Status(Base) then
            raise Node_Definitions.Status_Error;
        end if;

        Cais_Utilities.Check_Intentions(Base, Read_Relationships);

        Get_A_Relationship(Base, Rel_Name => Relation, Rel_Key => Key,
            Rel_Attributes => Attributes, Primary => Primary, Shadow_File =>
            Shadow_File);

        -- Shadow_File now contains the name of the shadow file for
        -- node to be opened.  The values in this node are returned in
        -- the open node handle.
        -- First check that we aren't about to allow the user to
        -- access the system node via CAIS interfaces...
        Shadow_Length := Character_Set.Last_Non_Space(Shadow_File);
        if Shadow_File(1 .. Shadow_Length) = Cais_Host_Dependent.
            Cais_System_Node then
            -- CAIS Spec 4.3.4.2(3) prohibits direct access to the
            -- System_Node. presumably this means that an attempt to
            -- Open it is an attempt to Open an inaccessible node, hence
            -- a Name_Error is raised by Open.
            raise Node_Definitions.Name_Error;
        end if;

        Set_Shadow_File_Name(Node, Shadow_File);
        Node_Internals.Read_Shadow_File(Node);
        Set_Open(Node, True);
        Set_Intent(Node, Intent);

        -- build a pathname from the base, relation, and key...
        Build_Name : declare
            Name                                : String(1 .. Max_Name_String);
            Name_Length, Rel_Length, Key_Length : Natural;
        begin
            Get_Pathname(Base, Name, Name_Length);
            Rel_Length := Last_Non_Space(Relation);
            Key_Length := Last_Non_Space(Key);
            Set_Pathname(Node, Name(1 .. Name_Length) & "'" & Relation(Relation'
                First .. Rel_Length) & "(" & Key(Key'First .. Key_Length) & ")")
                ;
        end Build_Name;

    exception
        when No_Such_Relation | No_Such_Relationship | No_Such_Shadow_File =>
            raise Node_Definitions.Name_Error;

    end Open;

----------------------      C L O S E          ----------------------
--
--  Purpose:
--  -------
--    This procedure severs any association between the node handle
--    "Node" and the node, and releases any associated locks on the
--    node imposed by the intent of the node handle "Node".  Closing
--    an alReady closed node handle has no effect.
--
--  Parameters:
--  ----------
--    Node - node handle, initially open, to be closed.
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--     CAIS 5.1.2.2
--
---------------------------------------------------------------------

    procedure Close(Node : in out Node_Type) is
        Shadow_File   : String(1 .. Max_Shadow_File_Length);
        Shadow_Length : Natural;
    begin
        if not Is_Open(Node) then
            return;
        end if;
        Get_Shadow_File_Name(Node, Shadow_File, Shadow_Length);
        if Cais_Host_Dependent.File_Exists(Shadow_File(1 .. Shadow_Length))
            then
            Write_Shadow_File(Node);
        end if;
        Set_Open(Node, False);
        -- when locks are implemented, release lock table entries
    end Close;

----------------------  C H A N G E _ I N T E N T -------------------
--
--  Purpose:
--  -------
--    This procedure changes the intention regarding the use of the node
--    handle "Node".  It is semantically equivalent to closing the node
--    handle an reopening the node handle to the same node with the
--    "Intent" and "Time_Limit" paramters of Change_Intent, except that
--    Change_Intent guarantees to return an open node handle that refers
--    to the same node as the node handle input in "Node".  (See the issue
--    explained in the nore below).
--
--  Parameters:
--  ----------
--    Node      - an open node handle
--    Intent    - the intent of subsequent operations on the node; the
--                actual parameter takes the form of an array aggregate.
--    Time_Limit- specifies the time limit for the delay on waiting on
--                waiting for the unlocking of a node in accordance with
--                the desired intent.
--
--  Exceptions:
--  ----------
--    Name_Error        - is raised if the node handle "Node" refers to
--                        an unobtainable node and "Intent" contains any
--                        intent specification other than "Existence".
--    Status_Error      - is raised if the node handle "Node" is not an
--                        open node handle.
--    Lock_Error        - is raised if the operation is delayed beyond the
--                        specified time limit due to the existence of locks
--                        on the node in conflict with the specified "Intent".
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--                        access to the node consistent with the specified
--                        intent.  Access_Violation is raised only of the
--                        condition for Name_Error is not present.
--    Security_Violation- is raised if an attempt to obtain access consistent
--                        with the intention "Intent" to the node specified
--                        by "Node" represents a violation of mandatory
--                        access controls for the CAIS.  Security_Violation
--                        is raised only if the conditions for other exceptions
--                        are not present.
--
--  Notes:  CAIS 5.1.2.3
--  -----
--    Use of the sequence of a Close and an Open operation instead of a
--    Change_Intent operation cannot guarantee that the same node is opened,
--    since relationships, and therefore the node identification, may have
--    changed since the previous Open on the Node.
--
---------------------------------------------------------------------

    procedure Change_Intent(Node       : in out Node_Type;
                            Intent     : Intention;
                            Time_Limit : Duration := No_Delay) is
    begin
        Assert_Fatal(False, "Change_Intent not implemented yet");
    end Change_Intent;

----------------------     I S _ O P E N       ----------------------
--
--  Purpose:
--  -------
--    This function returns True if the node handle "Node" is open;
--    otherwise, it returns FALSE.
--
--  Parameters:
--  ----------
--    Node - node handle
--
--  Exceptions:
--  ----------
--    None.
--
--  Notes:
--  -----
--     CAIS 5.1.2.4
--
---------------------------------------------------------------------

    function Is_Open(Node : Node_Type) return Boolean is
    begin
        return Node_Representation.Open_Status(Node);
    end Is_Open;


----------------------     I N T E N T _ O F   ----------------------
--
--  Purpose:
--  -------
--    This function returns the intent with which the node handle
--    Node is open.
--
--  Parameters:
--  ----------
--    Node   - an open node handle.
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error - if the node handle is not open.
--
--  Notes:
--  -----
--   CAIS 5.1.2.5
--
---------------------------------------------------------------------

    function Intent_Of(Node : Node_Type) return Intention is
    begin
        return Node_Representation.Get_Intent(Node);
    end Intent_Of;


----------------------        K I N D          ----------------------
--
--  Purpose:
--  -------
--    This function returns the kind of a node, either FILE, PROCESS,
--    or STRUCTURAL.
--
--  Parameters:
--  ----------
--    Node  - open node handle
--
--  Exceptions:
--  ----------
--    Node_Definitions.Status_Error  - if the node handle is not open.
--
--  Notes:
--  -----
--   CAIS 5.1.2.6
--
---------------------------------------------------------------------


    function Kind(Node : Node_Type) return Node_Kind is
    begin
        return Node_Representation.Get_Kind(Node);
    end Kind;


------------------------ P R I M A R Y _ N A M E---------------------
--
--  Purpose:
--  -------
--    This function returns the unique primary name of the node identified
--    by NODE.
--
--  Parameters:
--  ----------
--    Node      - an open node handle identifying the node of interest
--
--  Exceptions:
--  ----------
--    Name_Error        - is raised if any node traversed on the primary
--                        path is inaccessible.
--    Status_Error      - is raised if the Node_Handle "Node" is not open.
--    Lock_Error        - is raised if access consistent with intent
--                        Read_Relationships to any node traversed on the
--                        primary path cannot be obtained due to an existing
--                        lock on the node.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to traverse
--                        the node's primary path.  Access_Violation is raised
--              only if the conditions for Name_Error are not present.
--
--  Notes:   CAIS 5.1.2.7
--  -----
--    Get_Parent may raise Access_Violations. What should be done??
--    Get_Parent could raise Name_Error because the Node system is
--        inconsistent.  How can this be detected from the end to
--        recursion because w'eve reached a top level node??
---------------------------------------------------------------------
    function Primary_Name(Node : in Node_Type) return Name_String is
        Parent      : Node_Type;
        Shadow_File : String(1 .. Max_Shadow_File_Length);
        Attributes  : List_Type;
        Primary     : Boolean;

        function Append(Base     : String;
                        Relation : String;
                        Key      : String) return String is
        begin
            if Relation'Length = 3 and then Relation = "DOT" then
                return Base & "." & Key;
            else
                return Base & "'" & Relation & "(" & Key & ")";
            end if;
        end Append;
    begin

        Get_A_Relationship(Node, "Parent", "", Shadow_File, Attributes, Primary)
            ;

        if Last_Non_Space(Shadow_File) /= Cais_System_Node'Size or else
            Shadow_File /= Cais_System_Node then

            Get_Parent(Parent, Node, (1 => Read_Relationships));
                    --Raises Status, Lock, Intent, and Access Errors
                    --when appropriate! when the top-most level is
                    --reached the recursion will be terminated.
                                        --Recursive call!!!!!!!
            return Append(Primary_Name(Parent), Primary_Relation(Node),
                Primary_Key(Node));
        else
            return Append("", Primary_Relation(Node), Primary_Key(Node));
        end if;
    end Primary_Name;

------------------------ P R I M A R Y _ K E Y ----------------------
--
--  Purpose:
--  -------
--    This function returns the relationship key of the last path
--    element of the unique primary name of the node identified by NODE.
--
--  Parameters:
--  ----------
--    Node      - an open node handle identifying the node of interest
--
--  Exceptions:
--  ----------
--    Name_Error        - is raised if the parent node of the node identified
--                        by "Node" is inaccessible.
--    Status_Error      - is raised if the Node_Handle "Node" is not open.
--    Lock_Error        - is raised if the parent node is locked against
--                        Read_Relationships.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--              access to the node's parent consistent with intent
--              Read_Relationships.  Access_Violation is raised
--              only if the conditions for Name_Error are not present.
--
--  Notes:   CAIS 5.1.2.8
--  -----
--
---------------------------------------------------------------------
    function Primary_Key(Node : in Node_Type) return Relationship_Key is

        use Identifier_Items;

        Parent_Node : Node_Type;
        Attributes  : List_Type;
        Primary     : Boolean;
        Key_String  : String(1 .. Max_Relationship_Key);
        Shadow_File : String(1 .. Max_Shadow_File_Length);
        Key         : List_Type;
    begin
        if not Is_Open(Node) then
            raise Node_Definitions.Status_Error;
        end if;
        Check_Intentions(Node, Read_Relationships);

        Get_A_Relationship(Node, "Parent", "", Shadow_File, Attributes, Primary)
            ;

        --Open checks parent(other than System_Node) for existence and locks.
        if Last_Non_Space(Shadow_File) /= Cais_System_Node'Size or else
            Shadow_File /= Cais_System_Node then
            Open(Parent_Node, Node, "", "Parent", (1 => Read_Relationships));
            Close(Parent_Node);
        end if;

        Extract(Attributes, "Primary_Key", Key);
        Simple_List_To_String(Key, Key_String);
        return Key_String(1 .. Last_Non_Space(Key_String));
    end Primary_Key;

------------------- P R I M A R Y _ R E L A T I O N ------------------
--
--  Purpose:
--  -------
--    This function returns the relation name of the last path
--    element of the unique primary name of the node identified by NODE.
--
--  Parameters:
--  ----------
--    Node      - an open node handle identifying the node of interest
--
--  Exceptions:
--  ----------
--    Name_Error        - is raised if the parent node of the node identified
--                        by "Node" is inaccessible.
--    Status_Error      - is raised if the Node_Handle "Node" is not open.
--    Lock_Error        - is raised if the parent node is locked against
--                        Read_Relationships.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--              access to the node's parent consistent with intent
--              Read_Relationships.  Access_Violation is raised
--              only if the conditions for Name_Error are not present.
--
--  Notes:   CAIS 5.1.2.9
--  -----
--
---------------------------------------------------------------------
    function Primary_Relation(Node : in Node_Type) return Relation_Name is

        use Identifier_Items;

        Parent_Node : Node_Type;
        Attributes  : List_Type;
        Primary     : Boolean;
        Rel_String  : String(1 .. Max_Relationship_Name);
        Shadow_File : String(1 .. Max_Shadow_File_Length);
        Relation    : List_Type;
    begin
        if not Is_Open(Node) then
            raise Node_Definitions.Status_Error;
        end if;
        Check_Intentions(Node, Read_Relationships);

        Get_A_Relationship(Node, "Parent", "", Shadow_File, Attributes, Primary)
            ;

        --Open checks parent(other than System_Node) for existence and locks.
        if Last_Non_Space(Shadow_File) /= Cais_System_Node'Size or else
            Shadow_File /= Cais_System_Node then
            Open(Parent_Node, Node, "", "Parent", (1 => Read_Relationships));
            Close(Parent_Node);
        end if;

        Extract(Attributes, "Primary_Relation", Relation);
        Simple_List_To_String(Relation, Rel_String);
        return Rel_String(1 .. Last_Non_Space(Rel_String));
    end Primary_Relation;

----------------------    P A T H _ K E Y      ----------------------
--
--  Purpose:
--  -------
--    This function returns the relationship key of the relationship
--    corresponding to the last path element of the pathname used
--    in opening this node handle.  Since a path element is a string,
--    the relationship key is returned even if the relationship has
--    been deleted.
--
--  Parameters:
--  ----------
--    Node      - an open node handle
--
--  Exceptions:
--  ----------
--    Status_Error      - raised if the node handle "Node" is not open.
--
--  Notes:   CAIS 5.1.2.10
--  -----
--
---------------------------------------------------------------------

    function Path_Key(Node : Node_Type) return Relationship_Key is

        Lastchar : Natural;
        Name     : String(1 .. Pragmatics.Max_Name_String);

    begin
        if not Is_Open(Node) then
            raise Node_Definitions.Status_Error;
        end if;

        Node_Representation.Get_Pathname(Node, Name, Lastchar);
        return Last_Key(Name(1 .. Lastchar));
    end Path_Key;

----------------------     P A T H _ R E L A T I O N ----------------
--
--  Purpose:
--  -------
--    This function returns the relation name of the relationship
--    corresponding to the last path element of the pathname used
--    in opening this node handle.
--    The relationship key is returned even if the relationship has
--    been deleted.
--
--  Parameters:
--  ----------
--    Node      - an open node handle
--
--  Exceptions:
--  ----------
--    Status_Error      - raised if the node handle "Node" is not open.
--
--  Notes:   CAIS 5.1.2.11
--  -----
--
---------------------------------------------------------------------
    function Path_Relation(Node : Node_Type) return Relation_Name is

        Lastchar : Natural;
        Name     : String(1 .. Pragmatics.Max_Name_String);

    begin
        if not Is_Open(Node) then
            raise Node_Definitions.Status_Error;
        end if;

        Node_Representation.Get_Pathname(Node, Name, Lastchar);
        return Last_Relation(Name(1 .. Lastchar));
    end Path_Relation;

----------------------    B A S E _ P A T H    ----------------------
--
--  Purpose:
--  -------
--    This function returns the pathname obtained by deleting the last
--    path element from "Name".  It does not establish whether the
--    pathname identifies an existing node; only the syntactic properties
--    of the pathname are examined.  This function also checks the
--    legality of the pathname "Name".
--
--  Parameters:
--  ----------
--    Name      - a pathname (not necessarily identifying a node).
--
--  Exceptions:
--  ----------
--    Name_Error  - raised if Name is a syntactically illegal pathname.
--
--  Notes: CAIS 5.1.2.12
--  -----
--
---------------------------------------------------------------------

    function Base_Path(Name : Name_String) return Name_String is

        Pn         : Parsed_Pn;
        Rel_Key    : Relationship_Key(1 .. Max_Relationship_Key);
        Rel_Name   : Relation_Name(1 .. Max_Relationship_Name);
        Dyn_Name   : Dynamic_String;
        Dyn_Key    : Dynamic_String;
        Latest_Key : Boolean;
        Comp_Count : Natural;
        Tmp_Dyn    : Dynamic_String;
        Tmp_Str    : Name_String(1 .. Max_Name_String) := (others => ' ');

    begin
        Get_Parsed_Pn(Name, Pn);

        -- Must be at least one valid component, sice we didn't get a
        -- PATHNAME_SYNTAX_ERROR exception from Get_Parsed_PN...
        for I in 1 .. (Pn_Component_Count(Pn) - 1) loop
            Get_Pn_Component(Pn, I, Rel_Name, Rel_Key, Latest_Key);
            Convert_To_Dynamic(Rel_Key, Dyn_Key);
            Convert_To_Dynamic(Rel_Name, Dyn_Name);
            Append(''', Tmp_Dyn);
            if Length(Dyn_Name) = 0 then
                Append("DOT", Tmp_Dyn);
            else
                Append(Dyn_Name, Tmp_Dyn);
            end if;
            if Latest_Key then
                Append('#', Dyn_Key);
            end if;
            if not Empty(Dyn_Key) then
                Append('(', Tmp_Dyn);
                Append(Dyn_Key, Tmp_Dyn);
                Append(')', Tmp_Dyn);
            end if;
        end loop;

        if Length(Tmp_Dyn) = 0 then
            return " ";
        end if;
        Convert_To_String(Tmp_Dyn, Tmp_Str);
        return Tmp_Str(1 .. Length(Tmp_Dyn));

    exception
        when Pathname_Syntax_Error =>
            raise Node_Definitions.Name_Error;
        when others =>
            raise;
    end Base_Path;
----------------------   L A S T _ R E L A T I O N  -----------------
--
--  Purpose:
--  -------
--    This function returns the name of the relation of the last
--    path element of the pathname "Name".  It does not establish
--    whether the pathname identifies an existing node; only the
--    syntactic properties of the pathname are examined.  This function
--    also checks the syntactic legality of the pathname "Name".
--
--  Parameters:
--  ----------
--    Name   - a pathname, not necessarily identifying a node.
--
--  Exceptions:
--  ----------
--    Name_Error   - if name is syntactically illegal.
--
--  Notes:   CAIS 5.1.2.13
--  -----
--
---------------------------------------------------------------------

    function Last_Relation(Name : Name_String) return Relation_Name is

        Pn         : Parsed_Pn;
        Rel_Key    : Relationship_Key(1 .. Max_Relationship_Key);
        Rel_Name   : Relation_Name(1 .. Max_Relationship_Name);
        Latest_Key : Boolean;
        Comp_Count : Natural;

    begin
        Get_Parsed_Pn(Name, Pn);
        Comp_Count := Pn_Component_Count(Pn);

        -- Must be at least one valid component, sice we didn't get a
        -- Pathname_Syntax_Error exception from Get_Parsed_Pn...
        Get_Pn_Component(Pn, Comp_Count, Rel_Name, Rel_Key, Latest_Key);
        return (Rel_Name(1 .. Last_Non_Space(Rel_Name)));
    exception
        when Pathname_Syntax_Error =>
            raise Node_Definitions.Name_Error;
        when others =>
            raise;
    end Last_Relation;

------------------------     L A S T _ K E Y     --------------------
--
--  Purpose:
--  -------
--    This function returns the name of the relationship key of the last
--    path element of the pathname "Name".  It does not establish
--    whether the pathname identifies an existing node; only the
--    syntactic properties of the pathname are examined.  This function
--    also checks the syntactic legality of the pathname "Name".
--
--  Parameters:
--  ----------
--    Name   - a pathname, not necessarily identifying a node.
--
--  Exceptions:
--  ----------
--    Name_Error   - if name is syntactically illegal.
--
--  Notes:   CAIS 5.1.2.14
--  -----
--
---------------------------------------------------------------------

    function Last_Key(Name : Name_String) return Relationship_Key is

        Pn         : Parsed_Pn;
        Rel_Key    : Relationship_Key(1 .. Max_Relationship_Key);
        Rel_Name   : Relation_Name(1 .. Max_Relationship_Name);
        Latest_Key : Boolean;
        Comp_Count : Natural;

    begin
        Get_Parsed_Pn(Name, Pn);
        Comp_Count := Pn_Component_Count(Pn);

        -- Must be at least one valid component, sice we didn't get a
        -- Pathname_Syntax_Error exception from Get_Parsed_Pn...
        Get_Pn_Component(Pn, Comp_Count, Rel_Name, Rel_Key, Latest_Key);
        if Latest_Key then
            return (Rel_Key(1 .. Last_Non_Space(Rel_Key)) & '#');
        else
            return (Rel_Key(1 .. Last_Non_Space(Rel_Key)));
        end if;
    exception
        when Pathname_Syntax_Error =>
            raise Node_Definitions.Name_Error;
        when others =>
            raise;
    end Last_Key;

----------------------   I S _ O B T A I N A B L E  -----------------
--
--  Purpose:
--  -------
--    This function returns False if the node identified by "Node"
--    is unobtainable or inaccessible.  It returns True otherwise.
--
--  Parameters:
--  ----------
--    Node - an open node handle identifying the node
--
--  Exceptions:
--  ----------
--    Status_Error  - raised if "Node" is not an open node handle.
--
--  Notes:  CAIS 5.1.2.15
--  -----
--     For now, only check if the shadow file still exists...
--     locking and access control will force changes in this routine
--
---------------------------------------------------------------------

    function Is_Obtainable(Node : Node_Type) return Boolean is

        Lastchar : Natural;
        Name     : String(1 .. Pragmatics.Max_Name_String);

    begin
        if not Is_Open(Node) then
            raise Node_Definitions.Status_Error;
        end if;

        Node_Representation.Get_Shadow_File_Name(Node, Name, Lastchar);

        Check_Exists : declare
            File : String(1 .. Lastchar);
        begin
            File := Name(1 .. Lastchar);
            return File_Exists(File);
        end Check_Exists;

    end Is_Obtainable;

----------------------     I S _ S A M E      -----------------------
--
--  Purpose:
--  -------
--    This function returns True if the nodes identified by its
--    arguments are the same node; otherwise, it returns FALSE.
--
--  Parameters:
--  ----------
--    Node1   - open node handle to a node
--    Node2   - open node handle to a node
--
--  Exceptions:
--  ----------
--    Status_Error  is raised if either of the node handles is not open.
--
--  Notes:
--  -----
--      This is a version of the function Is_Same,
--      specified in MIL-STD-CAIS 5.1.2.16; all references to
--      the CAIS specification refer to the CAIS  specification
--      dated 31 January 1985.
--
---------------------------------------------------------------------

    function Is_Same(Node1 : Node_Type;
                     Node2 : Node_Type) return Boolean is

        Shadow1, Shadow2 : String(1 .. Max_Shadow_File_Length);
        Len1, Len2       : Natural;
    begin
        if not Open_Status(Node1) or not Open_Status(Node2) then
            raise Node_Definitions.Status_Error;
        end if;

        Get_Shadow_File_Name(Node1, Shadow1, Len1);
        Get_Shadow_File_Name(Node2, Shadow2, Len2);
        if Len1 /= Len2 then
            return False;
        end if;

        return (Shadow1(1 .. Len1) = Shadow2(1 .. Len2));
    end Is_Same;
----------------------------------------------------------------------
--        A D D I T I O N A L   I N T E R F A C E
----------------------------------------------------------------------
    function Is_Same(Name1 : Name_String;
                     Name2 : Name_String) return Boolean is
        Node1, Node2 : Node_Type;
        Result       : Boolean;
    begin
        Open(Node1, Name1, (1 => Existence));
        begin
            Open(Node2, Name2, (1 => Existence));
        exception
            when others =>
                Close(Node1);
                raise;
        end;
        Result := Is_Same(Node1, Node2);
        Close(Node1);
        Close(Node2);
        return Result;
    end Is_Same;

------------------------  G E T _ P A R E N T  ----------------------
--
--  Purpose:
--  -------
--    This procedure returns an open node handle in "Parent" to the parent
--    of the node identified by the open node handle "Node".  The intent
--    under which the node handle "Parent" is opened is specified by "Intent".
--    A call on Get_Parent is equivalent to a call:
--        Open(Parent, Node, "", Parent, Intent, Time_Limit);
--
--  Parameters:
--  ----------
--    Parent    - a node handle, initially closed, to be opened to the
--                parent node
--    Node      - an open handle identifying the node
--    Intent    - the intent of subsequent operations on the node "Parent";
--                the actual parameter takes the form of an array aggregate
--    Time_Limit - specifies time limit for the delay on waiting for the
--                unlocking of the parent node in accordance with the desired
--        - intent
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the node identified by "Node" is a top
--              level node or if its parent node is inaccessible.
--    Use_Error         - is raised if the specified intent is an empty array.
--    Status_Error      - is raised if the Node_Handle "Parent" is already
--                        open prior to the call on or if "Node" is not
--                        an open node handle.
--    Lock_Error        - is raised if the opening of the Parent node is
--              delayed beyond the specified time limit due to
--              the existance of locks in conflict with the
--              specified Intent.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to read relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--                        access to the parent node with the specified intent.
--                        Access_Violation is raised only if the conditions
--                        for Name_Error are not present.
--    Security_Violation -is raised if the attempt to obtain access to the
--                        parent node with the specified intent represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.17
--  -----
--
---------------------------------------------------------------------
    procedure Get_Parent(Parent     : in out Node_Type;
                         Node       : in Node_Type;
                         Intent     : Intention := (1 => Read);
                         Time_Limit : Duration := No_Delay) is
    begin
        Open(Parent, Node, "", "Parent", Intent, Time_Limit);
    end Get_Parent;

------------------------  C O P Y _ N O D E   ------------------------
--
--  Purpose:
--  -------
--    These procedures copy a file or structural node THAT DOES NOT HAVE
--    EMANATING PRIMARY RELATIONSHIPS.  The node copied is identified by
--    the open node handle "From" and is copied to a newly created node.
--    The new node is identified by the combination of the To_Base, To_Key,
--    and To_Relation parameters.  The newly created node is of the same
--    kind as the node identified by From. If the node is a file node, its
--    contents are also copied, i.e., a new copied file is created.  Any
--    secondary relationships emanating from the original node, excepting
--    the relation of the predefined relation parent(which is appropriately
--    adjusted), are recreated in the copy.  If the target of the original
--    nodes relationship IS THE NODE ITSELF, THEN THE COPY HAS AN ANALOGOUS
--    RELATION TO ITSELF.  Any other secondary relationship whose target is
--    the original node is unaffected.  All attributes of the From node are
--    also copied.  Regardless of any locks on the node identified by From,
--    the newly creasted node is unlucked.
--
--  Parameters:
--  ----------
--    From      - an open node handle to the node to be copied.
--    To_Base   - open node handle to a base node for identification of the
--          node to be created.
--    To_Key    - the relationship key for identification of the node to be
--              - created.
--    To_Relation  - the relation name for identification of the node to be
--                created.
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the new node identification is illegal
--                        or if a node already exists with the identification
--                        given for the new node.
--    Use_Error         - is raised if the origianl node is not a file or
--              structural node or if any primary relationships
--              emanate from the original node.  Use_Error is also
--              raised if the To_Relation is the name of a predefined
--              relation that cannot be modified or created by the
--              user.
--    Status_Error      - is raised if the Node_Handles From and To_Base are
--              not both open.
--    Intent_Violation  - is raised if "From" was not opened with an intent
--                        establishing the right to read contents, attributes
--              and relationships, or if To_Base was not opened with
--              the right to append relationships. Intent_Violation
--              is not raised if the conditions for name error are
--              present.
--    Security_Violation -is raised if the attempt to obtain access to the
--                        node with the specified intent represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.18
--  -----
--
---------------------------------------------------------------------

    procedure Copy_Node(From        : Node_Type;
                        To_Base     : in out Node_Type;
                        To_Key      : Relationship_Key;
                        To_Relation : Relation_Name := Default_Relation) is
        separate;

----------------------------------------------------------------------
--        A D D I T I O N A L   I N T E R F A C E
----------------------------------------------------------------------
    procedure Copy_Node(From : in Node_Type;
                        To   : in Name_String) is
        To_Base : Node_Type;
    begin
        Open(To_Base, Base_Path(To), (1 => Append_Relationships));
        Copy_Node(From, To_Base, Last_Key(To), Last_Relation(To));
        Close(To_Base);
    exception
        when others =>
            Close(To_Base);
            raise;
    end Copy_Node;

------------------       C O P Y _ T R E E       ------------------------
--
--  Purpose:
--  -------
--    These procedures copy a tree of file or structural nodes formed by the
--    primary relationships emanating from the node identified by the open node
--    handle From.  Primary relationships are recreated between corresponding
--    copied nodes.  The root node of the newly created tree corresponding to
--    the From node is the node identified by the combination of the To_Base,
--    To_Key, and To_Relation parameters.  If an exception is raised by the
--    procedure none of the nodes are copied.  Secondary relationships,
--    attributes, and node contents are copied as described for Copy_Node with
--    the following additional rules: secondary relationships between two nodes
--    which are both copied are recreated between the two copies.  Secondary
--    relationships emanating from a node which is copied, but which refer to
--    nodes outside the tree being copied, are copied so that they emanate from
--    the copy, but still refer to the original target node.  Secondary
--    relationships emanating from a node which is not copied, but which refer
--    to nodes inside the tree being copied, are unaffected.  If the node
--    identified by To_Base is part of the tree being copied, then the copy of
--    the node identified by From will not be copied recursively.
--
--  Parameters:
--  ----------
--    From      - an open node handle to the root node of the tree to be copied.
--    To_Base   - open node handle to a base node for identification of the
--          node to be created as root of the new tree.
--    To_Key    - the relationship key for identification of the node to be
--              - created as root of the new tree.
--    To_Relation  - the relation name for identification of the node to be
--                created as root of the new tree.
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the new node identification is illegal
--                        or if a node already exists with the identification
--                        given for the new node to be created as a copy of
--              the node identified by From.
--    Use_Error         - is raised if the origianl node is not a file or
--              structural node.  Use_Error is also raised if the
--              To_Relation is the name of a predefined relation
--              that cannot be modified or created by the user.
--    Status_Error      - is raised if the Node_Handles From and To_Base are
--              not both open.
--    Lock_Error    - is raised if any node to be copied except the node
--              identified by From is locked against read access to
--              attributes, relationships, or contents.
--    Intent_Violation  - is raised if "From" was not opened with an intent
--                        establishing the right to read contents, attributes
--              and relationships, or if To_Base was not opened with
--              the right to append relationships. Intent_Violation
--              is not raised if the conditions for name error are
--              present.
--    Access_Violation     - is raised if the current process' discretionary
--              access control rights are insufficient to obtain
--              access to each node to be copied with intent Read.
--              Access_Violation is not raised if conditions for
--              Name_Error are present.
--    Security_Violation -is raised if the operations represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.19
--  -----
--
---------------------------------------------------------------------

    procedure Copy_Tree(From        : Node_Type;
                        To_Base     : in out Node_Type;
                        To_Key      : Relationship_Key;
                        To_Relation : Relation_Name := Default_Relation) is
        separate;

----------------------------------------------------------------------
--        A D D I T I O N A L   I N T E R F A C E
----------------------------------------------------------------------
    procedure Copy_Tree(From : in Node_Type;
                        To   : in Name_String) is
        To_Base : Node_Type;
    begin
        Open(To_Base, Base_Path(To), (1 => Append_Relationships));
        Copy_Tree(From, To_Base, Last_Key(To), Last_Relation(To));
        Close(To_Base);
    exception
        when others =>
            Close(To_Base);
            raise;
    end Copy_Tree;


------------------------     R E N A M E     ------------------------
--
--  Purpose:
--  -------
--    These procedures rename a file or a structural node.  They delete
--    the Primary relationship to the node identified by "Node" and install
--    a new primary relationship to the node, emanating from the node
--    identified by "New_Base", with key and relation given by the New_KEy and
--    New_Relation parameters.  The parent relationship is changed accordingly.
--    This the unique primary path name of the node.  Existing secondary
--    relationships with the renamed node as target track the renaming, i.e.,
--    they have the renamed node as target.
--
--  Parameters:
--  ----------
--    Node      - an opened node handle to the node to be renamed.
--    New_Base  - open node handle to a base node from which the new primary
--          relationship to the renamed node emanates.
--    New_Key   - the relationship key for the new primary relationship
--    New_Relation  - the relation name for the new primary relationship
--
--  Exceptions:
--  ----------
--    Name_Error        - raised if the new node identification is illegal
--              or if a node already exists with the identification
--              given for the new node.
--    Use_Error         - is raised if the node identified by "Node" is not a
--              file or structural node or if the renaming cannot be
--              accomplished while still maintaining acircularity of
--              primary relationships (eg. if the new parent node
--              would be the renamed node).  Use Error is also raised
--              if New_Relation is the name of a predefined relation
--              that cannot be modified or createdby the user or if
--              the primary relationship to be deleted belongs to a
--              predefined relation that cannot be modified by the
--              user.
--    Status_Error      - is raised if the Node_Handle "Node" and "New_Base"
--                        are not open.
--    Lock_Error        - is raised if access with intent Write_Relationships,
--                        to the parent of the node to be renamed cannot be
--              obtained to due to an existing lock on the node.
--    Intent_Violation  - is raised if "Node" was not opened with an intent
--                        establishing the right to write relationships or
--              if "New_Base" was not opened with an intent
--                        establishing the right to append relationships.
--    Access_Violation  - is raised if the current process's discretionary
--                        access control rights are insufficient to obtain
--                        access to the parent of the node to be renamed
--                        with intent Write_Relationships and the conditions
--              for Name_Error are not present.
--    Security_Violation -is raised if the operation represents a
--                        violation of mandatory access controls for the
--                        CAIS.  Security_Violation is raised only if the
--                        conditions for other exceptions are not present.
--
--  Notes:   CAIS 5.1.2.20
--  -----
--
---------------------------------------------------------------------

    procedure Rename(Node         : in out Node_Type;
                     New_Base     : in out Node_Type;
                     New_Key      : Relationship_Key;
                     New_Relation : Relation_Name := Default_Relation) is
        separate;

----------------------------------------------------------------------
--        A D D I T I O N A L   I N T E R F A C E
----------------------------------------------------------------------
    procedure Rename(Node     : in out Node_Type;
                     New_Name : Name_String) is
        New_Base : Node_Type;
    begin
        Open(New_Base, Base_Path(New_Name), (1 => Append_Relationships));
        Rename(Node, New_Base, Last_Key(New_Name), Last_Relation(New_Name));
        Close(New_Base);
    exception
        when others =>
            Close(New_Base);
            raise;
    end Rename;

----------------------   D E L E T E _ N O D E ----------------------
--
--  Purpose:
--  -------
--    This procedure deletes the primary relationship to a node
--    identified by Node.  The node becomes unobtainable.  The node
--    handle Node is closed.  If the node is a process node and the
--    process is not yet terminated (see Section 5.2 of MIL-STD-CAIS),
--    Delete_Node aborts the process.
--
--  Parameters:
--  ----------
--    Node  - an open node handle to the node which is the target of
--            the primary relationship to be deleted.
--
--  Exceptions:
--  ----------
--    (all defined in Node_Definitions)
--    Name_Error          - if parent node of Node is inaccessable
--    Use_Error           - if any primary Relationships emanate from Node
--    Status_Error        - if Node is not open
--    Lock_Error          - if access, with intent Write_Relationships,
--                          to the parent of the node to be deleted
--                          cannot be obtained due to an existing lock
--                          on the node.
--    Intent_Violation    - if the node handle Node was not opened with
--                          an intent including Exclusive_Write and
--                          Read_Relationships.
--    Access_Violation    - if the current process does not have sufficient
--                          discretionary access control rights to obtain
--                          access to the parent of the node to be deleted
--                          with intent Write_Relationships and the
--                          conditions for Name_Error are not present.
--    Security_Violation  - if the operation represents a violation of
--                          mandatory access controls.  Security_Violation
--                          is raised only if the conditions for other
--                          exceptions are not present.
--
--  Notes:
--  -----
--    MIL-STD-CAIS 5.1.2.21
--     Locking support will have to be added here...
---------------------------------------------------------------------
    procedure Delete_Node(Node : in out Node_Type) is separate;

--------------------------------------------------------------------------
--        A D D I T I O N A L   I N T E R F A C E
--------------------------------------------------------------------------
    procedure Delete_Node(Name : Name_String) is
        Node : Node_Type;
    begin
        Open(Node, Name, (Exclusive_Write, Read_Relationships));
        Delete_Node(Node);
    exception
        when others =>
            Close(Node);
            raise;
    end Delete_Node;

----------------------   D E L E T E _ T R E E ----------------------
--
--  Purpose:
--  -------
--    This procedure effectively performs the Delete_Node operation for
--    a specified node and recursively applies Delete_Tree to all nodes
--    reachable by a unique primary pathname from the designated node.
--    The nodes whose primary relationships are to be deleted are opened
--    with intent Exclusive_Write, thus locking them for other operations.
--    The order in which the deletions of primary relationships is performed
--    is not specified.  If the Delete_Tree operation raises an exception,
--    none of the primary relationships is deleted.
--
--  Parameters:
--  ----------
--    Node  - an open node handle to the node at the root of the tree
--            whose primary relationships are to be deleted.
--
--  Exceptions:
--  ----------
--    (all defined in Node_Definitions)
--    Name_Error          - if parent node of Node or any of the target nodes of
--                primary relationships to be deleted are inaccessable
--    Use_Error           - if the primary Relationship of Node belongs to a
--                predefined relation that cannot be modified by the
--                user.
--    Status_Error        - if Node is not open
--    Lock_Error          - if access, with intent Write_Relationships,
--                          to the parent of the "Node" cannot be obtained due
--                to an existing lock or if a node handle identifying
--                any node whose unique primary path traverses the
--                node identified by Node cannot be opened with intent
--                Exclisive_Write.
--    Intent_Violation    - if the node handle Node was not opened with
--                          an intent including Exclusive_Write and
--                          Read_Relationships.
--    Access_Violation    - if the current process does not have sufficient
--                          discretionary access control rights to obtain
--                          access to the parent of the node specified by Node
--                          with intent Write_Relationships or to obtain
--                access to any target node of a primary relationship
--                to be deleted with the intent Exclusive_Write and
--                the conditions for Name_Error are not present.
--    Security_Violation  - if the operation represents a violation of
--                          mandatory access controls.  Security_Violation
--                          is raised only if the conditions for other
--                          exceptions are not present.
--
--  Notes:
--  -----
--    MIL-STD-CAIS 5.1.2.22
--     Locking support will have to be added here...
---------------------------------------------------------------------
    procedure Delete_Tree(Node : in out Node_Type) is separate;

----------------------------------------------------------------------
--        A D D I T I O N A L   I N T E R F A C E
----------------------------------------------------------------------
    procedure Delete_Tree(Name : Name_String) is
        Node : Node_Type;
    begin
        Open(Node, Name, (Exclusive_Write, Append_Relationships));
        Delete_Tree(Node);
    exception
        when others =>
            Close(Node);
            raise;
    end Delete_Tree;

-------------------------   L I N K   -------------------------------
--
--  Purpose:
--  -------
--    This procedure creates a secondary relationship between two existing
--    The procedure takes a node handle "Node" on the target node, a
--    node handle "New_Base" on the source node, and an explicit key
--    "New_Key" and a relation name "New_Relation" for the relationship
--    to be established from "New_Base" to "Node".
--
--  Parameters:
--  ----------
--    Node        - open node handle to the node to which the new
--                  secondary relationship points.
--    New_Base    - an open node handle to the base node from which the
--                  new secondary relationship to the node emanates.
--    New_Key     - the relationship key for the new secondary relationship
--    New_Relation - the relation name for the new secondary relationship
--
--  Exceptions:
--  ----------
--    Name_Error     - raised if the relationship key or the relation
--                     name are illegal or if a node already exists
--                     with the identification given by "New_Base",
--                     "New_Key", and "New_Relation".
--    Use_Eror       - raised if "New_Relation" is the name of a predefined
--                     relation that cannot be modified or created by the user.
--    Status_Error   - raised if the node handles "Node" and "New_Base" are
--                     not open.
--    Intent_Violation  - raised if "New_Base" was not opened with an intent
--                        establishing the right to append relationships.
--    Security_Violation - raised if the operation represents a violation
--                         of mandatory access controls.  Security_Violation
--                         is raised only if the conditions for other
--                         exceptions are not present.
--  Notes:   CAIS 5.1.2.23
--  -----
--
---------------------------------------------------------------------

    procedure Link(Node         : in out Node_Type;
                   New_Base     : in out Node_Type;
                   New_Key      : Relationship_Key;
                   New_Relation : Relation_Name := Default_Relation) is

        Shadow_File    : String(1 .. Max_Shadow_File_Length);
        Shadow_Length  : Natural;
        Is_Primary     : Boolean;
        Rel_Attributes : List_Type;
        Simple_List    : List_Type;

    begin

        if not Node_Representation.Open_Status(New_Base) or not
            Node_Representation.Open_Status(Node) then
            raise Node_Definitions.Status_Error;
        end if;
        Cais_Utilities.Check_Intentions(New_Base, Append_Relationships);

        -- verify that the specified relation is not a predefined one that
        -- the user cannot set.
        if Predefined(New_Relation, Cais_Utilities.Relation) then
            raise Node_Definitions.Use_Error;
        end if;

        -- see if relation and key refer to existing node
        Check_Relationship : begin
            Node_Representation.Get_A_Relationship(Node => New_Base, Rel_Name
                => New_Relation, Rel_Key => New_Key, Rel_Attributes =>
                Rel_Attributes, Primary => Is_Primary, Shadow_File =>
                Shadow_File);
            -- if we get here, the specified relationship alReady exists.
            -- This procedure call is history...
            raise Node_Definitions.Name_Error;
        exception
            when No_Such_Relation | No_Such_Relationship =>
                null;  -- the relationship does NOT exist...

        end Check_Relationship;

        -- get the shadowfile name for node, set_a_relationship
        -- The new relationship has the path attribute Kind
        Get_Shadow_File_Name(Node, Shadow_File, Shadow_Length);
        Copy(Rel_Attributes, Empty_List);
        Cais_Utilities.String_To_Simple_List(Node_Kind'Image(Get_Kind(Node)),
            Simple_List);
        Insert(Rel_Attributes, Simple_List, "Kind", 0);
        Set_A_Relationship(Node => New_Base, Rel_Name => New_Relation, Rel_Key
            => New_Key, Rel_Attributes => Rel_Attributes, Primary => False,
            Shadow_File => Shadow_File(1 .. Shadow_Length));

        Write_Shadow_File(New_Base);

    exception
        -- exceptions that are trapped (nothing propagated)
        -- exceptions that are propagated
        when Node_Definitions.Status_Error | Node_Definitions.Use_Error |
            Node_Definitions.Intent_Violation | Node_Definitions.Name_Error |
            Node_Definitions.Security_Violation =>
            raise;
        -- exceptions that are mapped to other exceptions
        when Cais_Internals_Exceptions.No_Such_Shadow_File =>
            raise Node_Definitions.Name_Error;
        -- predefined exceptions (propagated with trace)
        when Constraint_Error | Tasking_Error | Program_Error | Storage_Error |
            Numeric_Error =>
            Trace.Report("PREDEFINED EXCEPTION in Node_Management.Link");
            raise;
        -- unanticipated exceptions
        when others =>
            Set_Open(Node, False);
            Trace.Report("UNANTICIPATED EXCEPTION in Node_Management.Link");
            raise Trace.Assertion_Violation;

    end Link;


    -- Additional Interface
    procedure Link(Node     : in out Node_Type;
                   New_Name : Name_String) is

        New_Base : Node_Type;
    begin
        Open(New_Base, Base_Path(New_Name), (1 => Append_Relation