# ========== programs from chapter 4 ========== # bubble - bubble sort v(1) ... v(n) increasing subroutine bubble(v, n) integer i, j, k, n, v(n) for (i = n; i > 1; i = i - 1) for (j = 1; j < i; j = j + 1) if (v(j) > v(j+1)) { # compare k = v(j) # exchange v(j) = v(j+1) # v(j+1) = k # } return end # shell - Shell sort v(1)...v(n) increasing subroutine shell(v, n) integer gap, i, j, jg, k, n, v(n) for (gap = n/2; gap > 0; gap = gap/2) for (i = gap + 1; i <= n; i = i + 1) for (j = i - gap; j > 0; j = j - gap) { jg = j + gap if (v(j) <= v(jg)) # compare break k = v(j) # exchange v(j) = v(jg) # v(jg) = k # } return end define(MERGEORDER,7) define(NAMESIZE,20) define(MAXTEXT,400) define(MAXPTR,1000) define(LOGPTR,20) # sort - sort text lines in memory character linbuf(MAXTEXT) integer gtext integer linptr(MAXPTR), nlines if (gtext(linptr, nlines, linbuf, STDIN) == EOF) { call shell(linptr, nlines, linbuf) call ptext(linptr, nlines, linbuf, STDOUT) } else call error("too big to sort.") stop end # shell - Shell sort for character lines subroutine shell(linptr, nlines, linbuf) character linbuf(ARB) integer compar integer gap, i, ig, j, k, linptr(ARB), nlines for (gap = nlines/2; gap > 0; gap = gap/2) for (j = gap + 1; j <= nlines; j = j + 1) for (i = j - gap; i > 0; i = i - gap) { ig = i + gap if (compar(linptr(i), linptr(ig), linbuf) <= 0) break call exchan(linptr(i), linptr(ig), linbuf) } return end # gtext - get text lines into linbuf integer function gtext(linptr, nlines, linbuf, infile) character linbuf(MAXTEXT) integer getlin integer infile, lbp, len, linptr(MAXPTR), nlines nlines = 0 lbp = 1 repeat { len = getlin(linbuf(lbp), infile) if (len == EOF) break nlines = nlines + 1 linptr(nlines) = lbp lbp = lbp + len + 1 # "1" = room for EOS } until (lbp >= MAXTEXT-MAXLINE | nlines >= MAXPTR) gtext = len return end # ptext - output text lines from linbuf subroutine ptext(linptr, nlines, linbuf, outfil) character linbuf(MAXTEXT) integer i, j, linptr(MAXPTR), nlines, outfil for (i = 1; i <= nlines; i = i + 1) { j = linptr(i) call putlin(linbuf(j), outfil) } return end # compar - compare linbuf(lp1) with linbuf(lp2) integer function compar(lp1, lp2, linbuf) character linbuf(ARB) integer i, j, lp1, lp2 i = lp1 j = lp2 while (linbuf(i) == linbuf(j)) { if (linbuf(i) == EOS) { compar = 0 return } i = i + 1 j = j + 1 } if (linbuf(i) < linbuf(j)) compar = -1 else compar = +1 return end # exchan - exchange linbuf(lp1) with linbuf(lp2) subroutine exchan(lp1, lp2, linbuf) character linbuf(ARB) integer k, lp1, lp2 k = lp1 lp1 = lp2 lp2 = k return end # quick - quicksort for character lines subroutine quick(linptr, nlines, linbuf) character linbuf(ARB) integer compar integer i, j, linptr(ARB), lv(LOGPTR), nlines, p, pivlin, uv(LOGPTR) lv(1) = 1 uv(1) = nlines p = 1 while (p > 0) if (lv(p) >= uv(p)) # only one element in this subset p = p - 1 # pop stack else { i = lv(p) - 1 j = uv(p) pivlin = linptr(j) # pivot line while (i < j) { for (i=i+1; compar(linptr(i), pivlin, linbuf) < 0; i=i+1) ; for (j = j - 1; j > i; j = j - 1) if (compar(linptr(j), pivlin, linbuf) <= 0) break if (i < j) # out of order pair call exchan(linptr(i), linptr(j), linbuf) } j = uv(p) # move pivot to position i call exchan(linptr(i), linptr(j), linbuf) if (i-lv(p) < uv(p)-i) { # stack so shorter done first lv(p+1) = lv(p) uv(p+1) = i - 1 lv(p) = i + 1 } else { lv(p+1) = i + 1 uv(p+1) = uv(p) uv(p) = i - 1 } p = p + 1 # push onto stack } return end # sort - external sort of text lines character linbuf(MAXTEXT), name(NAMESIZE) integer gtext, makfil, min, open integer infil(MERGEORDER), linptr(MAXPTR), nlines integer high, lim, low, outfil, t high = 0 repeat { # initial formation of runs t = gtext(linptr, nlines, linbuf, STDIN) call quick(linptr, nlines, linbuf) high = high + 1 outfil = makfil(high) call ptext(linptr, nlines, linbuf, outfil) call close(outfil) } until (t == EOF) for (low = 1; low < high; low = low + MERGEORDER) { # merge lim = min(low+MERGEORDER-1, high) call gopen(infil, low, lim) high = high + 1 outfil = makfil(high) call merge(infil, lim-low+1, outfil) call close(outfil) call gremov(infil, low, lim) } call gname(high, name) # final cleanup outfil = open(name, READ) call fcopy(outfil, STDOUT) call close(outfil) call remove(name) stop end # gname - make unique name for file id n subroutine gname(n, name) character name(NAMESIZE) integer itoc, length integer i, junk, n # string stemp "stemp" integer stemp(6) data stemp(1), stemp(2), stemp(3)/ LETS, LETT, LETE/ data stemp(4), stemp(5), stemp(6)/ LETM, LETP, EOS/ call scopy(stemp, 1, name, 1) i = length(stemp) + 1 junk = itoc(n, name(i), NAMESIZE-i) return end # makfil - make new file for number n integer function makfil(n) character name(NAMESIZE) integer create integer n call gname(n, name) makfil = create(name, READWRITE) if (makfil == ERR) call cant(name) return end # gopen - open group of files low ... lim subroutine gopen(infil, low, lim) character name(NAMESIZE) integer i, infil(MERGEORDER), lim, low integer open for (i = 1; i <= lim-low+1; i = i + 1) { call gname(low+i-1, name) infil(i) = open(name, READ) if (infil(i) == ERR) call cant(name) } return end # gremov - remove group of files low ... lim subroutine gremov(infil, low, lim) character name(NAMESIZE) integer i, infil(MERGEORDER), lim, low for (i = 1; i <= lim-low+1; i = i + 1) { call close(infil(i)) call gname(low+i-1, name) call remove(name) } return end define(MERGETEXT,900) # merge - merge infil(1) ... infil(nfiles) onto outfil subroutine merge(infil, nfiles, outfil) character linbuf(MERGETEXT) integer getlin integer i, inf, lbp, lp1, nf, nfiles, outfil integer infil(MERGEORDER), linptr(MERGEORDER) lbp = 1 nf = 0 for (i = 1; i <= nfiles; i = i + 1) # get one line from each file if (getlin(linbuf(lbp), infil(i)) ^= EOF) { nf = nf + 1 linptr(nf) = lbp lbp = lbp + MAXLINE # room for largest line } call quick(linptr, nf, linbuf) # make initial heap while (nf > 0) { lp1 = linptr(1) call putlin(linbuf(lp1), outfil) inf = lp1 / MAXLINE + 1 # compute file index if (getlin(linbuf(lp1), infil(inf)) == EOF) { linptr(1) = linptr(nf) nf = nf - 1 } call reheap(linptr, nf, linbuf) } return end # reheap - propagate linbuf(linptr(1)) to proper place in heap subroutine reheap(linptr, nf, linbuf) character linbuf(MAXTEXT) integer compar integer i, j, nf, linptr(nf) for (i = 1; 2 * i <= nf; i = j) { j = 2 * i if (j < nf) # find smaller child if (compar(linptr(j), linptr(j+1), linbuf) > 0) j = j + 1 if (compar(linptr(i), linptr(j), linbuf) <= 0) break # proper position found call exchan(linptr(i), linptr(j), linbuf) # percolate } return end