DataMuseum.dk

top - download

    Length: 4683 (0x124b)
    Types: TextFile
    Notes: R1k Text-file segment

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦db497d070⟧ 
            └─⟦this⟧ 

TextFile

Version 2

Modif dans Kba :
 - creation d'un paquetage generic_class_server dans generic_class
  => (parametres du generic = taille de allocation mem pour les messages
      a stocker)

 - correction de display => plus de pb d'affichage
 
 - rappel : dans Kba une procedure One_inference_with_conflic_set a ete creee
            afin de pouvoir faire un update apres chaq inference du MI
            



Le serveur de class est le suivant:

       generic
            Max_Change_Operations : Natural;
            Max_Delete_Operations : Natural;
        package Generic_Class_Server is
            procedure Delete (The_User_Object : Class.User_Object);
            procedure Change (The_Fact : Class.User_Object;
                              The_Slot : Slot_Names;
                              To_Value : Slot.Object);
            procedure Update;

            Server_Storage_Capacity_Overflow : exception;
        end Generic_Class_Server;
        
        
        separate (Generic_Fact_Base.Generic_Class)

        package body Generic_Class_Server is


        task Server is
            entry Delete (The_User_Object : Class.User_Object);
            entry Change (The_Fact : Class.User_Object;
                          The_Slot : Slot_Names;
                          To_Value : Slot.Object);
            entry Update;
        end Server;


        type Delete_Messages is
            record
                What_Fact : Class.User_Object;
            end record;  
        type Change_Messages is
            record
                What_Fact : Class.User_Object;
                What_Slot : Slot_Names;
                The_Value : Slot.Object;
            end record;

        type Change_Messages_Table is
            array (1 .. Max_Change_Operations) of Change_Messages;
        type Delete_Messages_Table is
            array (1 .. Max_Delete_Operations) of Delete_Messages;


        task body Server is  
            The_Change_Msg_Table : Change_Messages_Table;
            The_Delete_Msg_Table : Delete_Messages_Table;
            Nbr_Change_Msg       : Natural := 0;
            Nbr_Delete_Msg       : Natural := 0;
        begin  
          loop
            select  
                accept Update do  -- bloque l'appelant

                    while (Nbr_Delete_Msg > 0) loop
                        Generic_Class.Delete
                           (The_Delete_Msg_Table (Nbr_Delete_Msg).What_Fact);
                        Nbr_Delete_Msg := Nbr_Delete_Msg - 1;
                    end loop;

                    while (Nbr_Change_Msg > 0) loop
                        Generic_Class.Change
                           (The_Change_Msg_Table (Nbr_Change_Msg).What_Fact,
                            The_Change_Msg_Table (Nbr_Change_Msg).What_Slot,
                            The_Change_Msg_Table (Nbr_Change_Msg).The_Value);
                        Nbr_Change_Msg := Nbr_Change_Msg - 1;
                    end loop;
                end Update;
            or
                accept Change (The_Fact : Class.User_Object;
                               The_Slot : Slot_Names;
                               To_Value : Slot.Object) do  
                    Nbr_Change_Msg := Nbr_Change_Msg + 1;
                    The_Change_Msg_Table (Nbr_Change_Msg).What_Fact := The_Fact;
                    The_Change_Msg_Table (Nbr_Change_Msg).What_Slot := The_Slot;
                    The_Change_Msg_Table (Nbr_Change_Msg).The_Value := To_Value;
                end Change;

            or
                accept Delete (The_User_Object : Class.User_Object) do
                    Nbr_Delete_Msg := Nbr_Delete_Msg + 1;
                    The_Delete_Msg_Table (Nbr_Delete_Msg).What_Fact :=
                       The_User_Object;
                end Delete;
            or
                terminate;

            end select;
         end loop;
        end Server;



        procedure Delete (The_User_Object : Class.User_Object) is
        begin
            Server.Delete (The_User_Object);  
        exception
            when Constraint_Error =>
                raise Server_Storage_Capacity_Overflow;
        end Delete;


        procedure Change (The_Fact : Class.User_Object;
                          The_Slot : Slot_Names;
                          To_Value : Slot.Object) is
        begin
            Server.Change (The_Fact, The_Slot, To_Value);  
        exception
            when Constraint_Error =>
                raise Server_Storage_Capacity_Overflow;
        end Change;


        procedure Update is
        begin
            Server.Update;
        end Update;


    end Generic_Class_Server;


!!!!!!!!! il ne faut pas oublier le update lors de l'inferenc