DataMuseum.dk

top - download

    Length: 4253 (0x109d)
    Types: TextFile
    Names: »B«

└─⟦25882cbde⟧ Bits:30000536 8mm tape, Rational 1000, RCI_RS6000_AIX_IBM 2_0_2
    └─ ⟦b8efda8ac⟧ »DATA« 
        └─⟦7061b4ee8⟧ 
            └─⟦this⟧ 

TextFile

separate (Batch_Extensions_Support)
procedure Generate_Ada_Commands (Host_File_Id : Io.File_Type;
                                 Host_Units : Dt.Object.Iterator;
                                 Target_Key : String;
                                 Status : in out Simple_Status.Condition) is
    Host_Units_Iter : Dt.Object.Iterator := Host_Units;
    Current_Object, Current_View : Directory.Object;
    Previous_View : Directory.Object := Directory.Nil;
    Has_Secondary : Boolean := False;
    First_Unit : Boolean := True;
    Error_Status : Directory.Error_Status;
    Compile_Pre_Command : constant String :=
       Tdi.Compiler_Pre_Command (Target_Key);
    Resp : Profile.Response_Profile := Profile.Get;
begin
    Dt.Object.Reset (Host_Units_Iter);
    -- Reset the object iterator

    while not Dt.Object.Done (Host_Units_Iter) loop
        -- First generate all secondary commands for the host units

        Dt.Object.Low_Level.Get_Object
           (Dt.Object.Value (Host_Units_Iter), Current_Object, Error_Status);
        -- Convert current handle to a directorty object

        if Directory."/=" (Error_Status, Directory.Successful) then
            Log.Put_Line ("Error in getting object from its handle",
                          Profile.Error_Msg);
            return;
        end if;

        Current_View := Du.Get_View (Current_Object, Resp);
        Ui.Has_Secondary (Current_Object, Has_Secondary, Status, Resp);
        -- Check if the current object has any secondary referencers

        if Has_Secondary and then not Ui.Process_Primary
                                         (Current_Object, Resp) then
            -- Do not generate commands for ADA primaries
            -- that have process primaries set to false

            Log.Put_Line ("Not generating ADA compile commands for" &
                          Naming.Unique_Full_Name (Current_Object),
                          Profile.Note_Msg);
        else
            Log.Put_Line ("Generating ADA compile commands for " &
                          Naming.Unique_Full_Name (Current_Object),
                          Profile.Note_Msg);

            if Directory."/=" (Current_View, Previous_View) then
                if not First_Unit then
                    Io.Put_Line (Host_File_Id, "!");
                end if;

                Generate_Context_Change_Command
                   (Host_File_Id, Current_Object, Target_Key, Status);
                -- Set remote context to the unit's remote directory

                if Compile_Pre_Command /= "" then
                    Io.Put_Line (Host_File_Id, Compile_Pre_Command);
                end if;

                Io.Put_Line
                   (Host_File_Id,
                    Build_Compile_Command (This_Target, Current_Object, Resp) &
                       " -I <<!");
                -- Write out the compilation comamnd with only
                -- the options but without unit names suffixed by the
                -- Unix redirect input notation
                -- eg: ada -o -v <<!


                First_Unit := False;  
                Previous_View := Current_View;
            end if;

            declare  
                Full_Remote_Unit_Name : constant String :=
                   Ui.Full_Remote_Unit_Name
                      (Naming.Get_Full_Name (Current_View),
                       Current_Object, Resp).Result;
            begin  
                if Full_Remote_Unit_Name = "" then
                    Log.Put_Line ("Error while getting remote unit name for " &
                                  Naming.Unique_Full_Name (Current_Object) &
                                  " while generating batch compile commands",
                                  Profile.Error_Msg);
                else  
                    Io.Put_Line (Host_File_Id, Full_Remote_Unit_Name);
                end if;
            end;
        end if;
        Dt.Object.Next (Host_Units_Iter);
    end loop;

    if not First_Unit then
        -- If at least one unit has been registered
        Io.Put_Line (Host_File_Id, "!");
        -- Specifiy end of standard input
    end if;
exception
    when others =>
        Unhandled_Exception (Status, "generate_ada_commands");
end Generate_Ada_Commands;