DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 5315 (0x14c3) Types: TextFile Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11 └─ ⟦129cab021⟧ »DATA« └─⟦this⟧ └─⟦f64eaa120⟧ Bits:30000752 8mm tape, Rational 1000, !projects 93 02 16 └─ ⟦6f12a12be⟧ »DATA« └─⟦this⟧ └─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04 └─ ⟦d65440be7⟧ »DATA« └─⟦this⟧
with Message_Interchange; with Text_Io; use Text_Io; package body Signature is Sep : Character renames Message_Interchange.Separator; First : Boolean; -- used to build images like blah#blah#blah -- instead of #blah#blah#blah Prototyping_Stub : exception; function Create return Signature.Object is begin return Object'(others => Parameter.Null_Parameter); end Create; procedure Add (To_Signature : in out Signature.Object; The_Parameter : Parameter.Object; At_Position : Position) is begin To_Signature (At_Position) := The_Parameter; end Add; function I (Sig : Object; Pos : Iterator_Range) return String is begin if Pos = Iterator_Range'Last then return ""; -- fin de la recursivite elsif Parameter.Is_Null (Sig (Position (Pos))) then --return I (Sig, Pos + 1); return ""; -- fin de la recursivite elsif First then First := False; return (Parameter.Image (Sig (Position (Pos))) & I (Sig, Pos + 1)); else return (Sep & Parameter.Image (Sig (Position (Pos))) & I (Sig, Pos + 1)); end if; end I; function Image (Of_Signature : Signature.Object) return String is begin First := True; return I (Of_Signature, Iterator_Range (Position'First)); end Image; function Value (Of_String : String) return Signature.Object is S : String renames Of_String; Name : Positive := S'First; Next_Name : Positive := S'First; Class : Positive := S'First; Value : Positive := S'First; Current : Positive := S'First; Param_Pos : Positive := 1; Sig : Signature.Object := Signature.Create; begin while Current <= S'Last loop Locate_Name: loop exit when S (Class) = Sep; Class := Class + 1; Current := Current + 1; end loop Locate_Name; Current := Current + 1; -- to point after the sep Value := Current; Locate_Class: loop exit when S (Value) = Sep; Value := Value + 1; Current := Current + 1; end loop Locate_Class; Current := Current + 1; -- to point after the sep Next_Name := Current; Locate_Value: loop exit when S (Next_Name) = Sep or Next_Name = S'Last; Next_Name := Next_Name + 1; Current := Current + 1; end loop Locate_Value; Current := Current + 1; -- to point after the sep if S (Next_Name) = Sep then Next_Name := Next_Name - 1; --[cheat] -- a parameter is always in the range name .. next_name -- this is required because there is no sep at the -- end of the signature end if; Signature.Add (To_Signature => Sig, The_Parameter => Parameter.Value (S (Name .. Next_Name)), At_Position => Param_Pos); Param_Pos := Param_Pos + 1; Name := Next_Name + 1 + 1; -- name is incremented twice see [cheat] Class := Name; Value := Name; Next_Name := Name; end loop; return Sig; end Value; procedure Init (Iter : in out Iterator; Signature : Standard.Signature.Object) is begin Iter.Position := Iterator_Range (Signature'First); Iter.Signature := Signature; end Init; procedure Next (Iter : in out Iterator) is begin Iter.Position := Iter.Position + 1; end Next; function Is_Done (Iter : Iterator) return Boolean is begin return Iter.Position = Iterator_Range'Last; end Is_Done; function Value (Iter : Iterator) return Parameter.Object is begin return Iter.Signature (Positive (Iter.Position)); end Value; procedure Reset (Signature : in out Standard.Signature.Object) is begin for I in Signature'Range loop Signature (I) := Parameter.Null_Parameter; end loop; end Reset; function Is_Equal (Left, Right : Signature.Object) return Boolean is begin for I in Left'Range loop if not Parameter.Is_Equal (Left (I), Right (I)) then return False; end if; end loop; return True; end Is_Equal; function Is_Compatible (Left, Right : Signature.Object) return Boolean is begin for I in Left'Range loop if not Parameter.Is_Compatible (Left (I), Right (I)) then return False; end if; end loop; return True; end Is_Compatible; procedure Strip_Values (Signature : in out Standard.Signature.Object) is begin for I in Signature'Range loop Parameter.Strip_Value (Signature (I)); end loop; end Strip_Values; end Signature;