|
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: 7168 (0x1c00) Types: Ada Source Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Signature, seg_052277
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000 └─ ⟦cfc2e13cd⟧ »Space Info Vol 2« └─⟦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;
nblk1=6 nid=0 hdr6=c [0x00] rec0=24 rec1=00 rec2=01 rec3=012 [0x01] rec0=19 rec1=00 rec2=02 rec3=022 [0x02] rec0=1e rec1=00 rec2=03 rec3=010 [0x03] rec0=1f rec1=00 rec2=04 rec3=010 [0x04] rec0=27 rec1=00 rec2=05 rec3=00e [0x05] rec0=1b rec1=00 rec2=06 rec3=000 tail 0x21759a4c687a063399f47 0x42a00088462060003