# ========== smaller programs from chapter 2 ========== # entab - replace blanks by tabs and blanks character getc character c integer tabpos integer col, i, newcol, tabs(MAXLINE) call settab(tabs) col = 1 repeat { newcol = col while (getc(c) == BLANK) { # collect blanks newcol = newcol + 1 if (tabpos(newcol, tabs) == YES) { call putc(TAB) col = newcol } } for ( ; col < newcol; col = col + 1) call putc(BLANK) # output leftover blanks if (c == EOF) break call putc(c) if (c == NEWLINE) col = 1 else col = col + 1 } stop end # tabpos - return YES if col is a tab stop integer function tabpos(col, tabs) integer col, i, tabs(MAXLINE) if (col > MAXLINE) tabpos = YES else tabpos = tabs(col) return end # settab - set initial tab stops subroutine settab(tabs) integer mod integer i, tabs(MAXLINE) for (i = 1; i <= MAXLINE; i = i + 1) if (mod(i, 8) == 1) tabs(i) = YES else tabs(i) = NO return end define(NOSKIP,PLUS) define(SKIP,STAR) # overstrike - convert backspaces into multiple lines character getc character c integer max integer col, newcol col = 1 repeat { newcol = col while (getc(c) == BACKSPACE) # eat up backspaces newcol = max(newcol-1, 1) if (newcol < col) { # start overstrike line call putc(NEWLINE) call putc(NOSKIP) for (col = 1; col < newcol; col = col + 1) call putc(BLANK) } else if (col == 1 & c ^= EOF) # start normal line call putc(SKIP) # else middle of line if (c == EOF) break call putc(c) # normal character if (c == NEWLINE) col = 1 else col = col + 1 } stop end define(RCODE,STAR) define(MAXCHUNK,10) define(THRESH,5) # compress - compress standard input character getc character buf(MAXCHUNK), c, lastc integer nrep, nsave # must have RCODE > MAXCHUNK or RCODE = 0 nsave = 0 for (lastc = getc(lastc); lastc ^= EOF; lastc = c) { for (nrep = 1; getc(c) == lastc; nrep = nrep + 1) if (nrep >= MAXCHUNK) # count repetitions break if (nrep < THRESH) # append short string for ( ; nrep > 0; nrep = nrep - 1) { nsave = nsave + 1 buf(nsave) = lastc if (nsave >= MAXCHUNK) call putbuf(buf, nsave) } else { call putbuf(buf, nsave) call putc(RCODE) call putc(lastc) call putc(nrep) } } call putbuf(buf, nsave) # put last chunk stop end # putbuf - output buf(1) ... buf(nsave), clear nsave subroutine putbuf(buf, nsave) character buf(MAXCHUNK) integer i, nsave if (nsave > 0) { call putc(nsave) for (i = 1; i <= nsave; i = i + 1) call putc(buf(i)) } nsave = 0 return end define(RCODE,STAR) # expand - uncompress standard input character getc character c, code while (getc(code) ^= EOF) if (code == RCODE) { # expand repetition if (getc(c) == EOF) break if (getc(code) == EOF) break for ( ; code > 0; code = code - 1) call putc(c) } else { # expand chunk for ( ; code > 0; code = code - 1) { if (getc(c) == EOF) break call putc(c) } if (c == EOF) break } stop end define(MAXKEY,50) # crypt - encrypt and decrypt character getc, xor character c, key(MAXKEY) integer getarg, mod integer i, keylen keylen = getarg(1, key, MAXKEY) if (keylen == EOF) call error("usage: crypt key.") for (i = 1; getc(c) ^= EOF; i = mod(i, keylen) + 1) call putc(xor(c, key(i))) stop end # xor - exclusive-or of a and b character function xor(a, b) character and, not, or character a, b xor = or(and(a, not(b)), and(not(a), b)) return end