old/PAS/List/sortir.pas

type
  plist = ^list;
  list  = record
      val  : integer;
      prev : plist;
  end;

Procedure AddList(val : integer; var last:plist);
var
  newli : plist;
begin
  newli := last;
  New(last);
  last^.val := val;
  last^.prev := newli;
end;

var
  last : plist;
  newli: plist;
  k    : plist;
  ends2: plist;
  vas,io: integer;
begin
  New(last);
  last^.prev := nil;
  WriteLn('Enter Numbers, ended with error:');
  ReadLN(last^.val);
  {$I-}
  repeat
    readln(vas);
    io := IOResult;
    if (io<>0) then break;
    AddList(vas,last);
  until false;
  {$I+}

  New(newli);
  newli^.val := last^.val;
  newli^.prev := nil;
  k := last^.prev;
  Dispose(last);
  last := k;
  k := newli;

  repeat
     while (k^.val > last^.val) and (k^.prev <> nil) do k := k^.prev;
     if (k^.prev = nil) and (k^.val > last^.val) then
       begin
        New(ends2);
        ends2^.prev := nil;
        ends2^.val := last^.val;
        k^.prev := ends2;
       end
     else
      begin
        New(ends2);
        ends2^.prev := k^.prev;
        k^.prev := ends2;
        ends2^.val := k^.val;
        k^.val     := last^.val;
      end;
     k := last^.prev;
     Dispose(last);
     last := k;
     k := newli;
  until last = nil;
  WriteLn('Output:');
  repeat
   k := newli^.prev;
   WriteLn(newli^.val);
   Dispose(newli);
   newli := k;
  until k = nil;
  WriteLn('End');
end.