|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 4467 (0x1173) 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« └─⟦c80c19d53⟧ └─⟦this⟧
package Detail is type Detail_Kind is (Real_Field, Real_Complement, Group_Complement, Group_Field, Unknown); type Object (Kind : Detail_Kind := Unknown) is private; procedure Create_Real_Field (Item : in out Object; An_Index : in Positive); procedure Create_Real_Complement (Item : in out Object; An_Index : in Positive); procedure Create_Group_Field (Item : in out Object; Position : in Positive); procedure Create_Group_Complement (Item : in out Object; Position : in Positive); procedure Show (Item : in Object); function Is_A_Real_Field (Item : in Object) return Boolean; function Is_A_Real_Complement (Item : in Object) return Boolean; function Is_A_Group_Field (Item : in Object) return Boolean; function Is_A_Group_Complement (Item : in Object) return Boolean; function Exist (Item : in Object) return Boolean; function Index (Item : in Object) return Natural; function Image (Item : Object) return String; Null_Object : constant Object; private type Object (Kind : Detail_Kind := Unknown) is record case Kind is when Real_Field => Field_Index : Natural := 0; when Real_Complement => Complement_Index : Natural := 0; when Group_Field => Field_Position : Natural := 0; when Group_Complement => Complement_Position : Natural := 0; when Unknown => null; end case; end record; Null_Object : constant Object := (Kind => Unknown); end Detail; with Text_Io, The_Order, Complement_Identifier_Array, Field_Identifier_Array; package body Detail is procedure Create_Real_Field (Item : in out Object; An_Index : in Positive) is begin Item := (Kind => Real_Field, Field_Index => An_Index); end Create_Real_Field; procedure Create_Real_Complement (Item : in out Object; An_Index : in Positive) is begin Item := (Kind => Real_Complement, Complement_Index => An_Index); end Create_Real_Complement; procedure Create_Group (Item : in out Object; Position : in Positive) is begin Item := (Kind => Group, Group_Position => Position); end Create_Group; procedure Show (Item : in Object) is begin Text_Io.Put_Line ("Detail : Kind : " & Detail_Kind'Image (Item.Kind) & " Image : " & Image (Item)); end Show; function Is_A_Real_Field (Item : in Object) return Boolean is begin return Item.Kind = Real_Field; end Is_A_Real_Field; function Is_A_Real_Complement (Item : in Object) return Boolean is begin return Item.Kind = Real_Complement; end Is_A_Real_Complement; function Is_A_Group_Field (Item : in Object) return Boolean is begin return Item.Kind = Group_Field; end Is_A_Group_Field; function Is_A_Group_Complement (Item : in Object) return Boolean is begin return Item.Kind = Group_Complement; end Is_A_Group_Complement; function Exist (Item : in Object) return Boolean is begin return Index (Item) /= 0; end Exist; function Index (Item : in Object) return Natural is begin case Item.Kind is when Real_Field => return Item.Field_Index; when Real_Complement => return Item.Complement_Index; when Group_Field => return Field_Identifier_Array.Index (Complement_Identifier_Array.Image (The_Order.Complement (Item.Group_Position))); when Group_Complement => return The_Order.Complement (Item.Group_Position); when Unknown => return 0; end case; end Index; function Image (Item : Object) return String is begin case Item.Kind is when Real_Field | group_field => return Field_Identifier_Array.Image (Index(item)); when real_complement | Group_complement => return field_Identifier_Array.Image (The_Order.Complement (Index(item)); when Unknown => return ""; end case; end Image; end Detail;