//		S   O   R   T
// Copyright Xerox Corporation 1979

//	E. McCreight
//	last edited by R. Johnsson May 20, 1980  2:54 PM

get "altofilesys.d"
get "COMSTRUCT.bcpl"

static [
	directoryOutOfSort
	]


let SORT(SV, ISPAUSE) = valof

	[ static [ j; swaps ]

	if DIRSTATE ne SORTING then
		[ DIRSTATE = SORTING
		j = 2
		swaps = 0
		Flip()
		]

	[Jloop if (j&17b) eq 0 & ISPAUSE() then resultis true
	let new = SV!j
	if Compare(lv (SV!(j-1))>>MYDE.S, lv new>>MYDE.S) gr 0 then
	  [
	  let i = BinSearch(SV, lv new>>MYDE.S, j-1)
	  if i eq j-1 %
	    Compare(lv (SV!i)>>MYDE.S, lv new>>MYDE.S) gr 0 then i = i-1
	  for k = j-1 to i+1 by -1 do SV!(k+1) = SV!k
	  SV!(i+1) = new
	  swaps = swaps + 1
	  ]
	if j eq SV!0 then break
	j = j + 1
	]Jloop repeat

	Flip()
	directoryOutOfSort = SV!0/swaps ls 5
	resultis false
	]


and Flip() be
	[
//	for i = #431 to #431+15 do @i = not @ i
	]

and Compare(s1, s2) = valof	// compares strings; returns -, 0, +
	[
	let COMP = 0
	let l1 = s1>>STRING.length
	let l2 = s2>>STRING.length
	let lx = (l1 ls l2)? l1, l2
	for i=1 to lx do
		[ let c1 = GetLCChar(s1,i)
		let c2 = GetLCChar(s2,i)
		if c1 eq c2 then loop
		COMP = c1-c2
		break
		]
	if COMP eq 0 then resultis  l1-l2
	resultis COMP
	]

and BinSearch(SV, Prefix, u; numargs na) = valof

	[ let l = 1
	if na ls 3 then u = SV!0
	let PrefLen = Prefix>>STRING.length
	let i = nil

	while l le u do
		[ i = (l+u) rshift 1
		let MYDE = SV!i
		let DELen = MYDE>>MYDE.S.length
		let COMP = 0

		for k=1 to ((PrefLen ls DELen)? PrefLen, DELen) do
			[ let CP = GetLCChar(Prefix,k)
			let CD = GetLCChar(lv MYDE>>MYDE.S,k)
			if CP eq CD loop
			COMP = CP-CD
			break
			]
		if COMP eq 0 then COMP = PrefLen-DELen

		if COMP eq 0 then break

		test COMP gr 0

		ifso	l = i+1

		ifnot	u = i-1
		]

	resultis i
	]