Source code in the pl/i programming language

*process source xref attributes or(!);
 /*********************************************************************
 * Pseudocode found here:
 *   http://en.wikipedia.org/wiki/Heapsort#Pseudocode
 * Sample data from REXX
 * 27.07.2013 Walter Pachl
 *********************************************************************/
 heaps: Proc Options(main);
 Dcl a(0:25) Char(50) Var Init(
      '---letters of the modern Greek Alphabet---',
      '==========================================',
      'alpha','beta','gamma','delta','epsilon','zeta','eta','theta',
      'iota','kappa','lambda','mu','nu','xi','omicron','pi',
      'rho','sigma','tau','upsilon','phi','chi','psi','omega');
 Dcl n Bin Fixed(31) Init((hbound(a)+1));

 Call showa('before sort');
 Call heapsort((n));
 Call showa(' after sort');

 heapSort: Proc(count);
   Dcl (count,end) Bin Fixed(31);
   Call heapify((count));
   end=count-1;
   do while(end>0);
     Call swap(end,0);
     end=end-1;
     Call siftDown(0,(end));
     End;
   End;

 heapify: Proc(count);
   Dcl (count,start) Bin Fixed(31);
   start=(count-2)/2;
   Do while (start>=0);
     Call siftDown((start),count-1);
     start=start-1;
     End;
   End;

 siftDown: Proc(start,end);
   Dcl (count,start,root,end,child,sw) Bin Fixed(31);
   root=start;
   Do while(root*2+1<= end);
     child=root*2+1;
     sw=root;
     if a(sw)
       sw=child;
     if child+1<=end & a(sw)
       sw=child+1;
     if sw^=root Then Do;
       Call swap(root,sw);
       root=sw;
       End;
     else
       return;
     End;
   End;

 swap: Proc(x,y);
 Dcl (x,y) Bin Fixed(31);
 Dcl temp Char(50) Var;
   temp=a(x);
   a(x)=a(y);
   a(y)=temp;
   End;

 showa: Proc(txt);
 Dcl txt Char(*);
 Dcl j Bin Fixed(31);
 Do j=0 To hbound(a);
   Put Edit('element',j,txt,a(j))(skip,a,f(3),x(1),a,x(1),a);
   End;
 End;

 End;