Uses Crt;

Type
  Inf = String;
  Ptr = ^EL;
  EL = record
            Dn : Inf;
            Nx : Ptr;
           end;

  Queue = object
           p : ptr;
           Constructor Init;
           Function Empty : boolean;
           Procedure Push(D : Inf);
           Procedure Print;
           Function Pop : Inf;
           Destructor Done;
           end;


Constructor Queue.Init;
begin
  p := nil
end;

Destructor Queue.Done;
var q : Ptr;
begin
  while p <> nil do
  begin
     q := p;
     p := p^.Nx;
     dispose(q);
  end;
  p := nil;
end;

Function Queue.Empty : boolean;
begin
  If p = nil then
  Empty := false
  else Empty := true;
end;

Procedure Queue.Push(D : Inf);
var q : Ptr;
begin
  New(q);
  q^.Dn := D;
  q^.Nx := p;
  p := q;
end;

Function Queue.Pop : Inf;
var q : Ptr;
begin
  q := p;
  If q^.Nx = nil then
  begin
     Pop := q^.Dn;
     dispose(q);
     p := nil;
  end;

  While q^.Nx^.Nx <> nil do q := q^.Nx;
  Pop := q^.Dn;
  dispose (q^.Nx);
  q^.Nx := nil;
end;

Procedure Queue.Print;
var q : Ptr;
begin
  q := p;
  while q <> nil do
  begin
     write(q^.Dn : 4, ' ');
     q := q^.Nx;
  end;
  writeln;
end;

var   Q1 : Queue;
     input, output : text;
     s, sl : string;
     i, code : integer;

 BEGIN

   ClrScr;
   assign(input, 'input.txt');
   reset(input);
   assign(output, 'output.txt');
   rewrite(output);
   Q1.Init;
   writeln('DO= ',MemAvail);
   writeln;
   While not EOF(input) do
     begin
        sl := '';
        readln(input, s);
        If s[length(s)] <> ' '
        then s := s + ' ';
        For i := 1 to length(s) do
        If s[i] <> ' '
        then
           sl := sl + s[i]
        else
        If length(sl) <> 0 then
        begin
           Q1.Push(sl);
           sl := '';
        end;
     end;

   Q1.Print;
   Q1.Done;
   Close(input);
   writeln;
   writeln('POSLE= ',MemAvail);
   readkey;

END.

Destructor Queue.Done;
begin
 while not Empty do Pop
end;

Function Queue.Empty : boolean;
begin
 Empty := (p = nil)
end;

type
 trec = record
   count: integer;
   ch: char;
 end;
 ttype = trec;

{$i dds_lib\item.pas}
type
 pttype = ^ttype;
 tqueue = object
   head, tail: ptitem;

   constructor init;
   destructor done;

   procedure put(x: ttype);
   function get: pttype;

   function empty: boolean;
 private
   last_read: pttype;
 end;


constructor tqueue.init;
 begin
   head := nil; tail := nil;
   new(last_read)
 end;
destructor tqueue.done;
 begin
   dispose(last_read);
   while empty do get
 end;

procedure tqueue.put(x: ttype);
 var p: ptitem;
 begin
   new(p, init(x, nil));
   if empty then head := p
   else tail^.next := p;
   tail := p
 end;

function tqueue.get: pttype;
 var p: ptitem;
 begin
   get := nil;
   if not empty then
     begin
       p := head;
       head := head^.next;

       last_read^ := p^.info;
       dispose(p, done);
       get := last_read
     end
   else
     begin
       writeln('reading from empty queue');
       halt(102)
     end;
 end;

function tqueue.empty: boolean;
 begin
   empty := not assigned(head)
 end;

{ Все самое интересное - здесь... }
var
 q: tqueue;

procedure convert_str(s: string);
var
 i, err: integer;
 to_number: string;
 r: trec;
begin
 i := 1; to_number := '';
 while i <= length(s) do begin
   while s[i] in ['0' .. '9'] do
     begin
       to_number := to_number + s[i];
       inc(i);
     end;
   val(to_number, r.count, err);
   to_number := '';
   r.ch := s[i]; inc(i);

   q.put(r)
 end;

end;

var
 f: text;
 s: string;
 pr: pttype;
 i: integer;

begin
 assign(f, 'fenix.txt');
 {$i-} reset(f); {$i+}

 q.init;
 while not eof(f) do begin
   readln(f, s);
   convert_str(s)
 end;

 while not q.empty do
   begin
     pr := q.get;
     for i := 1 to pr^.count do
       write(pr^.ch);
   end;

 q.done;

 close(f)
end.

type
 ttype = word;

 ptitem = ^titem;
 titem =
   record
     data: ttype;
     next: ptitem;
   end;

 tqueue = object
   head, tail: ptitem;
   constructor init;
   destructor done;

   procedure put(x: ttype);
   function get: ttype;

   function empty: boolean;
   procedure print;
 end;


constructor tqueue.init;
begin
 head := nil; tail := nil;
end;
destructor tqueue.done;
begin
 while not empty do get
end;

procedure tqueue.put(x: ttype);
var p: ptitem;
begin
 new(p);
 p^.data := x;
 p^.next := nil;
 if empty then head := p
 else tail^.next := p;
 tail := p
end;

function tqueue.get: ttype;
var p: ptitem;
begin
 if not empty then begin
   p := head;
   head := head^.next;

   get := p^.data;
   dispose(p);
 end
 else begin
   writeln('reading from empty queue');
   halt(102)
 end;
end;

function tqueue.empty: boolean;
begin
 empty := not assigned(head)
end;

procedure tqueue.print;
var p: ptitem;
begin
 p := head;
 write('(queue) <');
 while assigned(p) do begin
   write(p^.data, ' ');
   p := p^.next
 end;
 writeln('>')
end;

{
 Вот до этого места - все, как у тебя -
 очередь которая работает с Word-ами
}

{ А вот дальше... }
type
{
 определяем запись в которой поля count и ch
 хранятся там же, где и поле to_queue (они физически
 занимают одно место в памяти).
 Это называется запись с селектором
}
 trec = record
 case boolean of
   false: (count: byte; ch: char);
   true : (to_queue: word);
 end;

var
 q: tqueue;
 f: text;

procedure convert_str(s: string);
var
 i, err: integer;
 to_number: string;
 r: trec;
begin
 i := 1; to_number := '';
 while i <= length(s) do begin
   while s[i] in ['0' .. '9'] do
     begin
       to_number := to_number + s[i];
       inc(i);
     end;
   val(to_number, r.count, err);
   to_number := '';
   r.ch := s[i]; inc(i);

   q.put(r.to_queue)
{
 пишем то мы содержимое поля to_queue, но
 эффект такой, как будто мы записали другие 2 поля
}
 end;

end;

var
 s: string;
 i: integer;
 rec: trec;

begin
 assign(f, 'fenix.txt');
 {$i-} reset(f); {$i+}

 q.init;
 while not eof(f) do begin
   readln(f, s);
   convert_str(s)
 end;

 while not q.empty do
   begin
{
 то же самое и с чтением, читаем вроде бы Word,
 но на самом деле рассматриваем его как Byte + Char
}
     rec.to_queue := q.get;
     for i := 1 to rec.count do
       write(rec.ch);
   end;

 q.done;
 close(f)
end.