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: 1227 (0x4cb) Types: TextFile Names: »B«
└─⟦2f6cfab89⟧ Bits:30000547 8mm tape, Rational 1000, !projects 94-01-04 └─ ⟦d65440be7⟧ »DATA« └─⟦this⟧
with Text_Io; package body Fifo is Freecells : Pcell;--lien avec les elements libres function Newcell (E : in Integer) return Pcell is Result : Pcell; begin if Freecells /= null then Result := Freecells; Freecells := Freecells.Suc; Result.all := Cell'(E, null); return Result; else return new Cell'(E, null); end if; end Newcell; procedure Oldcell (O : Pcell) is begin O.Suc := Freecells; Freecells := O; end Oldcell; procedure Enqueue (F : in out Object; E : in Integer) is begin F.Tail.Suc := Newcell (E); F.Tail := F.Tail.Suc; end Enqueue; procedure Dequeue (F : in out Object; E : out Integer) is Tempo : Pcell; begin if F = Emptyfifo then raise Empty; else E := F.Head.Val; Tempo := F.Head.Suc; Oldcell (F.Head); F.Head := Tempo; end if; end Dequeue; begin for I in 1 .. 50 loop Freecells := new Cell'(0, Freecells); end loop; exception when Storage_Error => Text_Io.Put_Line ("erreur package fifo"); end Fifo;