========== other routines from chapter 4 ========== # unique - strip adjacent duplicate lines character buf1(MAXLINE), buf2(MAXLINE) integer equal, getlin integer t t = getlin(buf1, STDIN) while (t ~= EOF) { call putlin(buf1, STDOUT) for (t = getlin(buf2, STDIN); t ~= EOF; t = getlin(buf2, STDIN)) if (equal(buf1, buf2) == NO) break if (t == EOF) break call putlin(buf2, STDOUT) for (t = getlin(buf1, STDIN); t ~= EOF; t = getlin(buf1, STDIN)) if (equal(buf1, buf2) == NO) break $@$ stop end define(FOLD,DOLLAR) # kwic - make keyword in context index character buf(MAXLINE) integer getlin while (getlin(buf, STDIN) ~= EOF) call putrot(buf, STDOUT) stop end # putrot - create lines with keyword at front subroutine putrot(buf, outfil) character type character buf(ARB), t integer i, outfil for (i = 1; buf(i) ~= NEWLINE; i = i + 1) { t = type(buf(i)) if (t == LETTER | t == DIGIT) { # alpha call rotate(buf, i, outfil) # token starts at "i" t = type(buf(i+1)) for ( ; t == LETTER | t == DIGIT; t = type(buf(i+1))) i = i + 1 $@$ $@$ return end # rotate - output rotated line subroutine rotate(buf, n, outfil) character buf(ARB) integer i, n, outfil for (i = n; buf(i) ~= NEWLINE; i = i + 1) call putch(buf(i), outfil) call putch(FOLD, outfil) for (i = 1; i < n; i = i + 1) call putch(buf(i), outfil) call putch(NEWLINE, outfil) return end # type - determine type of character character function type(c) character c integer index # string digits "0123456789" integer digits(11) # string lowalf "abcdefghijklmnopqrstuvwxyz" integer lowalf(27) # string upalf "ABCDEFGHIJKLMNOPQRSTUVWXYZ" integer upalf(27) data digits(1) /DIG0/ data digits(2) /DIG1/ data digits(3) /DIG2/ data digits(4) /DIG3/ data digits(5) /DIG4/ data digits(6) /DIG5/ data digits(7) /DIG6/ data digits(8) /DIG7/ data digits(9) /DIG8/ data digits(10) /DIG9/ data digits(11) /EOS/ data lowalf(01)/LETA/ data lowalf(02)/LETB/ data lowalf(03)/LETC/ data lowalf(04)/LETD/ data lowalf(05)/LETE/ data lowalf(06)/LETF/ data lowalf(07)/LETG/ data lowalf(08)/LETH/ data lowalf(09)/LETI/ data lowalf(10)/LETJ/ data lowalf(11)/LETK/ data lowalf(12)/LETL/ data lowalf(13)/LETM/ data lowalf(14)/LETN/ data lowalf(15)/LETO/ data lowalf(16)/LETP/ data lowalf(17)/LETQ/ data lowalf(18)/LETR/ data lowalf(19)/LETS/ data lowalf(20)/LETT/ data lowalf(21)/LETU/ data lowalf(22)/LETV/ data lowalf(23)/LETW/ data lowalf(24)/LETX/ data lowalf(25)/LETY/ data lowalf(26)/LETZ/ data lowalf(27)/EOS/ data upalf(01) /BIGA/ data upalf(02) /BIGB/ data upalf(03) /BIGC/ data upalf(04) /BIGD/ data upalf(05) /BIGE/ data upalf(06) /BIGF/ data upalf(07) /BIGG/ data upalf(08) /BIGH/ data upalf(09) /BIGI/ data upalf(10) /BIGJ/ data upalf(11) /BIGK/ data upalf(12) /BIGL/ data upalf(13) /BIGM/ data upalf(14) /BIGN/ data upalf(15) /BIGO/ data upalf(16) /BIGP/ data upalf(17) /BIGQ/ data upalf(18) /BIGR/ data upalf(19) /BIGS/ data upalf(20) /BIGT/ data upalf(21) /BIGU/ data upalf(22) /BIGV/ data upalf(23) /BIGW/ data upalf(24) /BIGX/ data upalf(25) /BIGY/ data upalf(26) /BIGZ/ data upalf(27) /EOS/ if (index(lowalf, c) > 0) type = LETTER else if (index(upalf, c) > 0) type = LETTER else if (index(digits, c) > 0) type = DIGIT else type = c return end define(FOLD,DOLLAR) define(MIDDLE,40) define(MAXOUT,80) # unrot - unrotate lines rotated by kwic character inbuf(MAXLINE), outbuf(MAXOUT) integer getlin, index integer i, j while (getlin(inbuf, STDIN) ~= EOF) { for (i = 1; i < MAXOUT; i = i + 1) # blank line outbuf(i) = BLANK j = MIDDLE for (i = 1; inbuf(i) ~= FOLD & inbuf(i) ~= NEWLINE; i = i + 1) { j = j + 1 # copy up to FOLD if (j >= MAXOUT - 1) j = 1 outbuf(j) = inbuf(i) $@$ if (inbuf(i) == FOLD) { # copy second half, j = MIDDLE # working backwards for (i = index(inbuf, NEWLINE) - 1; i > 0; i = i - 1) { if (inbuf(i) == FOLD) break j = j - 1 if (j <= 0) j = MAXOUT - 2 outbuf(j) = inbuf(i) $@$ $@$ for (i = MAXOUT - 2; i > 0; i = i - 1) if (outbuf(i) ~= BLANK) # delete trailing blanks break outbuf(i+1) = NEWLINE # terminate line properly outbuf(i+2) = EOS call putlin(outbuf, STDOUT) $@$ stop end