1           sort_comp:  proc;
  2                     /*  sort's standard comparison routine            */
  3           dcl       b_str bit(32000) based,       /*  used for bit string data type  */
  4                     fb1(0:32000) fixed bin(35) based,       /*  used for bin, aligned, size = 36 bits-1 word  */
  5                     fb2(0:32000) fixed bin(71) based,       /*  used for bin, aligned, size = 72 bits-2 words  */
  6                     (work_1,work_2) fixed bin(71),/*  used for bin unaligned  */
  7                     flb1(0:32000) float bin(27) based,      /*  used for float bin, aligned, size = 36 bits-1 word  */
  8                     flb2(0:32000) float bin(63) based,      /*  used for float bin, aligned, size = 72 bits-2 words  */
  9                     (work_3,work_4) float bin(63) aligned,  /*  used for float bin,unaligned  */
 10                     (work_5,work_6) dec(59),      /*  used for decimal  */
 11                     (work_7,work_8) float dec(59);  /*  floating decimal-taking 61 bytes  */
 12           dcl       dec_char char(61) based aligned,
 13                     dec_ptr1 ptr,
 14                     dec_ptr2 ptr;
 15           dcl       dec_ptr3 ptr,
 16                     dec_ptr4 ptr;
 17               if compare_sw ^= 0 then
 18                     do;  /*  invoke user's compare routine  */
 19                      result = sort_ext$sort_compare_exit(pt1,pt2);
 20                      if result ^= 0 then go to con;
 21                     end;
 22               else do;
 23               do i1 = 0 to no_of_keys;
 24               go to lab(dt(i1));
 25   lab(1):           /*  data type = char  */
 26               if substr(pt1->S,b(i1),leng(i1))<
 27                  substr(pt2->S,b(i1),leng(i1))
 28                     then result = -1;  /*  record 1 ranks first  */
 29                     else if substr(pt1->S,b(i1),leng(i1))>
 30                             substr(pt2->S,b(i1),leng(i1))
 31                                  then result = 1;
 32                                  else go to next_key;
 33                     go to esc;
 34   lab(2):           /*  data type = bit  */
 35               if substr(pt1->b_str,b(i1),leng(i1)) <
 36                  substr(pt2->b_str,b(i1),leng(i1))
 37                     then result = -1;
 38                     else if substr(pt1->b_str,b(i1),leng(i1)) >
 39                             substr(pt2->b_str,b(i1),leng(i1))
 40                                  then result = 1;  /*  record 2 ranks first  */
 41                                  else go to next_key;
 42                     go to esc;
 43   lab(3):                     /*  data type = binary-aligned-size= 1 word  */
 44               if pt1->fb1(w(i1)) <
 45                  pt2->fb1(w(i1))
 46                     then result = -1;    /*  record 1 ranks first  */
 47                     else if pt1->fb1(w(i1))>
 48                             pt2->fb1(w(i1))
 49                               then result = 1;  /*  record 2 ranks first  */
 50                               else go to next_key;
 51                     go to esc;
 52   lab(4):           /*  data type = binary-aligned-size = 2 words  */
 53               if pt1->fb2(w(i1)) <
 54                  pt2->fb2(w(i1))
 55                     then result = -1;  /*  record 1 ranks first  */
 56                     else if pt1->fb2(w(i1)) >
 57                             pt2->fb2(w(i1))
 58                               then result = 1;  /*  record 2 ranks first  */
 59                               else go to next_key;
 60                     go to esc;
 61   lab(5):           /*  data type = binary-unaligned: 1<= len <= 71  */
 62               work_1 = 0;
 63               work_2 = 0;               /*  0 out work areas  */
 64               substr(unspec(work_1),1,leng(i1)+1)=substr(pt1->b_str,b(i1),leng(i1)+1);
 65                     /*  move unaligned bit string into aligned work field  */
 66               substr(unspec(work_2),1,leng(i1)+1)=substr(pt2->b_str,b(i1),leng(i1)+1);
 67               if work_1 < work_2 then result = -1;  /*  record 1 ranks first  */
 68                                  else if work_1 > work_2 then result = 1;  /*  record 2 ranks first  */
 69                                         else go to next_key;
 70                     go to esc;
 71   lab(6):           /*  data type = floating bin-aligned,size = 1 word  */
 72               if pt1->flb1(w(i1)) <
 73                  pt2->flb1(w(i1))
 74                     then result = -1;  /*  record 1 ranks first  */
 75                     else if pt1->flb1(w(i1)) >
 76                             pt2->flb1(w(i1))
 77                               then result = 1;  /*  record 2 ranks first  */
 78                               else go to next_key;
 79                     go to esc;
 80   lab(7):           /*  data type = floating bin - aligned, size = 2 words  */
 81               if pt1->flb2(w(i1)) <
 82                  pt2->flb2(w(i1))
 83                     then result = -1;  /*  record 1 ranks first  */
 84                     else if pt1->flb2(w(i1)) >
 85                             pt2->flb2(w(i1))
 86                               then result = 1;  /*  record 2 ranks first  */
 87                               else go to next_key;
 88                     go to esc;
 89   lab(8):           /*  data type = floating bin-unaligned  */
 90               work_3 = 0;
 91               work_4 = 0;  /*  0 out work areas  */
 92               substr(unspec(work_3),1,leng(i1)+9)=substr(pt1->b_str,b(i1),leng(i1)+9);
 93               substr(unspec(work_4),1,leng(i1)+9)=substr(pt2->b_str,b(i1),leng(i1)+9);
 94                     /*  move unaligned bit string into aligned work field  */
 95               if work_3 < work_4 then result = -1;  /*  recordnks first  */
 96                                  else if work_3 > work_4 then result = 1;  /*  record 2 ranks first  */
 97                                         else go to next_key;
 98                     go to esc;
 99   lab(9):           /*  data type = decimal  */
100               work_5 = 0;
101                dec_ptr3 = addr(work_5);
102               work_6 = 0;  /*  0 out work areas  */
103                dec_ptr4 = addr(work_6);
104               substr(dec_ptr3->dec_char,1,leng(i1)+1)=substr(pt1->S,b(i1),leng(i1)+1);
105               substr(dec_ptr4->dec_char,1,leng(i1)+1)=substr(pt2->S,b(i1),leng(i1)+1);
106                     /*  move decimal field into work field  */
107               if work_5 < work_6 then result = -1;  /*  record 1 ranks first  */
108                                  else if work_5 > work_6 then result = 1;  /*  record 2 ranks first  */
109                                                          else go to next_key;
110                     go to esc;
111   lab(10):                    /*  data type = floating decimal  */
112               work_7 = 0;
113                dec_ptr1 = addr(work_7);
114               work_8 = 0;  /*  0 out work areas  */
115                dec_ptr2 = addr(work_8);
116               substr(dec_ptr1->dec_char,1,leng(i1)+1)=substr(pt1->S,b(i1),leng(i1)+1);
117               substr(dec_ptr2->dec_char,1,leng(i1)+1)=substr(pt2->S,b(i1),leng(i1)+1);
118                     /*  move sign and digits into work areas  */
119               substr(dec_ptr1->dec_char,61,1)=substr(pt1->S,leng(i1)+1+b(i1),1);
120               substr(dec_ptr2->dec_char,61,1)=substr(pt2->S,leng(i1)+1+b(i1),1);
121                     /*  move exponent portion into work field  */
122               if work_7 < work_8 then result = -1;  /*  record 1 ranks first  */
123                                  else if work_7 > work_8 then result = 1;  /*  record 2 ranks first  */
124                                                          else go to next_key;
125                     go to esc;
126   next_key: end;    /*  ends do loop  */
127               result = 0;    /*  all keys equal  */
128               return;
129   esc:        if rev(i1) ^= 0 then result = -result;  /*  reverse ranking  */
130   con:  end;    /*  ends sort's comparison routine  */
131           end sort_comp;