!PROGRAM NAME: quicksort 
!
!This program sorts the contents of the file specified by the columns
!entered and resaves the sorted file.
!
dim D$(30000)[80] !  Defines the maximum number of 80 char lines
dim File$[80]     !  Path name to data file to be sorted
!
!  Left:  Left column of field to be sorted.
!  Right: Right column of field to be sorted by.
!  N:     Count of lines to be sorted.
!
call Get_user_data(Left,Right,File$,Out$)
call Read_it(D$(*),N,File$)
call Quicksort(D$(*),N,Left,Right)
call Save_it(D$(*),N,Out$)
!
end
!
!*******************************************************************************
!
sub Get_user_data(Left,Right,File$,Out$)
!
beep
input"Enter absolute path name to file to be sorted",File$
input"Enter absolute path name to save file",Out$
if len(Out$)=0 then
   print"Your file to be sorted will be overwritten with sorted data"
   Out$=File$
end if
!
beep
loop
   input"Left, right columns for sort",Left,Right
   exit if (Left<=Right) and (Left>0) and (Right<=80)
   beep
   if Left>Right then
      print "Left column must be less than or equal to the right column!"
   end if
   if Left<=0 then
      print "Left column input is out of range; must be greater than zero."
   end if
   if Right>80 then
      print"Right column input is out of range, must be less than 81."
   end if
   print "Try Again."
end loop
!
subend
!
!*******************************************************************************
!
sub Read_it(D$(*),N,File$)
!
loop
   assign @Old,Error to File$;read,exclusive
   exit if not(Error)
   beep
   print "Error number ";Error;"detected when attempting to access file:"
   print File$
   print "Re-enter file name."
   input "Enter absolute path name to file to be sorted",File$
end loop
!
print "Reading ";File$
N=1
loop
   enter @Old,,Error using "80a";D$(N)
     !print "D$(J) in sub Read_it (line 101)",D$(N)
   exit if Error
   N=N+1
end loop
N=N-1
!
assign @Old to *
!
subend
!
!*******************************************************************************
!*******************************************************************************
sub Quicksort (D$(*),N,Left,Right)
!
dim Stack(20,2)   !  Stack for storing indices of lists remaining to be sorted.
dim Q$[80]        !  Temporary copy of first element in list.
!
!    Other variables used:
!  Slen:       Length of field being sorted by.
!  Stack_ptr:  Pointer to the top of the stack, i.e. the next list to be sorted.
!  Ub:         Index of the last element in the current list.
!  Lb:         Index of the first element in the current list.
!  Up:         Index of the current location of elements greater than the
!              selected element.
!  Down:       Index of the current location of elements less than the
!              selected element.
!  J:          The final location of the selected element.
!  I:          Temporary variable.
!
!
print "Sorting start time: ";time$
Slen=Right-Left+1
Lb=1
Ub=N
Stack_ptr=0
!IF THE DATA TO BE SORTED IS 'ALMOST' IN ORDER, THESE LINES WILL PREVENT
!THE QUICKSORT ROUTINE FROM DEGENERATING. IF THE DATA IS RANDOMLY ORDERED,
!THESE LINES MAY BE DELETED WITH NO EFFECT ON THE SORT PERFORMANCE.
      Mid=(Ub+Lb) div 2
      Q$=D$(Mid)
      D$(Mid)=D$(Lb)
      D$(Lb)=Q$
call Push(Stack(*),Stack_ptr,Ub,Lb)
loop
   exit if Stack_ptr=0
   call Pop(Stack(*),Stack_ptr,Ub,Lb)
   loop
      exit if not (Ub>Lb)
!-------------------------------------------------------------------------------
      Q$=D$(Lb)
      J=Lb
      Up=Ub
      Down=Lb
      loop
         loop
            exit if (Up<=Down) or (D$(Up)[Left;Slen]<Q$[Left;Slen])
            Up=Up-1
         end loop
         J=Up
         if (Up<>Down) then
            D$(Down)=D$(Up)
            loop
               exit if (Down>=Up) or (D$(Down)[Left;Slen]>Q$[Left;Slen])
               Down=Down+1
            end loop
            J=Down
            if (Down<>Up) then
               D$(Up)=D$(Down)
            end if
         end if
         exit if (Down=Up)
      end loop
      D$(J)=Q$
!-------------------------------------------------------------------------------
      if(J-Lb)>(Ub-J) then
         I=Ub
         Ub=J-1
         call Push(Stack(*),Stack_ptr,Ub,Lb)
         Lb=J+1
         Ub=I
      else
         I=Lb
         Lb=J+1
         call Push(Stack(*),Stack_ptr,Ub,Lb)
         Lb=I
         Ub=J-1
      end if
   end loop
end loop
!
print "Sorting stop time: ";time$
!
subend
!
!*******************************************************************************
!
sub Push(Stack(*),Stack_ptr,Ub,Lb)
!
Stack_ptr=Stack_ptr+1
Stack(Stack_ptr,1)=Lb
Stack(Stack_ptr,2)=Ub
!
subend
!
!*******************************************************************************
!
sub Pop(Stack(*),Stack_ptr,Ub,Lb)
!
Lb=Stack(Stack_ptr,1)
Ub=Stack(Stack_ptr,2)
Stack_ptr=Stack_ptr-1
!
subend
!*******************************************************************************
!*******************************************************************************
sub Save_it(D$(*),N,Out$)
!
loop
   assign @New,Error to Out$;write,exclusive
   exit if not(Error)
   print "Error ";Error;" detected when attempting to save file:"
   print Out$
   print "Program terminated."
   stop
end loop
!
print "Saving ";Out$
for I=1 to N
   output @New using "80a,/";D$(I)
next I
!
assign @New to *
!
subend
!
!*******************************************************************************
!