Source code in the pl/i programming language

/* Handles both negative and positive values. */

maxval: procedure (z) returns (fixed binary);
   declare z(*) fixed binary;
   declare (maxv initial (0), i) fixed binary;
   do i = lbound(z,1) to hbound(z,1);
      maxv = max(z(i), maxv);
   end;
   put skip data (maxv); put skip;
   return (maxv);
end maxval;
minval: procedure (z) returns (fixed binary);
   declare z(*) fixed binary;
   declare (minv initial (0), i) fixed binary;

   do i = lbound(z,1) to hbound(z,1);
      if z(i) < 0 then minv = min(z(i), minv);
   end;
   put skip data (minv); put skip;
   return (minv);
end minval;

/* To deal with negative values, array elements are incremented */
/* by the greatest (in magnitude) negative value, thus making   */
/* them positive. The resultant values are stored in an         */
/* unsigned array (PL/I provides both signed and unsigned data  */
/* types). At procedure end, the array values are restored to   */
/* original values.                                             */

(subrg, fofl, size, stringrange, stringsize):
beadsort: procedure (z);                        /* 8-1-2010 */
   declare (z(*)) fixed binary;
   declare b(maxval(z)-minval(z)+1) bit (maxval(z)-minval(z)+1) aligned;
   declare (i, j, k, m, n) fixed binary;
   declare a(hbound(z,1)) fixed binary unsigned;
   declare offset fixed binary initial (minval(z));

   PUT SKIP LIST('CHECKPOINT A'); PUT SKIP;
   n = hbound(z,1);
   m = hbound(b,1);

   if offset < 0 then
      a = z - offset;
   else
      a = z;

   b = '0'b;

   do i = 1 to n;
      substr(b(i), 1, a(i)) = copy('1'b, a(i));
   end;
   do j = 1 to m; put skip list (b(j)); end;

   do j = 1 to m;
      k = 0;
      do i =1 to n;
         if substr(b(i), j, 1) then k = k + 1;
      end;
      do i = 1 to n;
         substr(b(i), j, 1) = (i <= k);
      end;
   end;
   put skip;
   do j = 1 to m; put skip list (b(j)); end;

   do i = 1 to n;
      k = 0;
      do j = 1 to m; k = k + substr(b(i), j, 1); end;
      a(i) = k;
   end;
   if offset < 0 then z = a + offset; else z = a;

end beadsort;

*process source attributes xref;
 /* Handles both negative and positive values. */
 Beadsort: Proc Options(main);
 Dcl sysprint Print;
 Dcl (hbound,max,min) Builtin;

 Dcl z(10) Bin Fixed(31) Init(10,-12,1,0,999,8,2,2,4,4);
 Dcl s(10) Bin Fixed(31);
 Dcl (init,lo,hi) Bin Fixed(31) Init(0);
 Dcl (i,j) Bin Fixed(31) Init(0);

 Call minmax(z,init,lo,hi);

 Begin;
 Dcl beads(lo:hi) Bin Fixed(31);
 beads=0;
 Do i=1 To hbound(z);
   beads(z(i))+=1;
   End;
 Do i=lo To hi;
   Do While(beads(i)>0);
     j+=1;
     s(j)=i;
     beads(i)-=1;
     End;
   End;
 Put Edit(' Input:',(z(i) Do i=1 To hbound(z)))(skip,a,99(f(4)));
 Put Edit('Sorted:',(s(i) Do i=1 To hbound(s)))(skip,a,99(f(4)));
 End;

 minmax: Proc(z,init,lo,hi);
 Dcl z(*) Bin Fixed(31);
 Dcl (init,lo,hi) Bin Fixed(31);
 Do i=1 To hbound(z);
   If init=0 Then Do;
     init=1;
     lo,hi=z(i);
     End;
   Else Do;
     lo=min(lo,z(i));
     hi=max(hi,z(i));
     End;
   End;
 End;

 End;