(COMPARE RTF QDETAB RTF KENTAB RTF 7EXAMPLE RTF"?F77DEF RAT%rINCLUDE RTF- |QSORT RTF9&RATCOMNSRAT_ 8LRATFOR COMj!RATLIB RELN0TRNLIT RTFa0&UNIQUE RTF +WRDCNT RTF-22APR86DWN include "b:ratdefn.rtf" define(READ,RDONLY) define(NAMESIZE,50) # compare - compare two files for equality character arg1(MAXLINE), arg2(MAXLINE) character line1(MAXLINE), line2(MAXLINE) integer equal, getarg, getlin, fopen integer infil1, infil2, lineno, m1, m2 call initio if (getarg(1, arg1, MAXLINE) == EOF | getarg(2, arg2, MAXLINE) == EOF) call error("usage: compare file1 file2.") infil1 = fopen(arg1, READ) if (infil1 == ERR) call cant(arg1) infil2 = fopen(arg2, READ) if (infil2 == ERR) call cant(arg2) lineno = 0 repeat { m1 = getlin(line1, infil1) m2 = getlin(line2, infil2) if (m1 == EOF | m2 == EOF) break lineno = lineno + 1 if (equal(line1, line2) == NO) call difmsg(lineno, line1, line2) } if (m1 == EOF & m2 ^= EOF) call remark("eof on file 1.") else if (m2 == EOF & m1 ^= EOF) call remark("eof on file 2.") call putc(EOF) stop end # difmsg subroutine difmsg(lineno, line1, line2) integer line1(MAXLINE), line2(MAXLINE) integer lineno call putdec(lineno, 5) call putc(NEWLINE) call putlin(line1, STDOUT) call putlin(line2, STDOUT) return end  ineno, 5) call putc(NEWLINE) call putlin(line1, STDOUT) call putlin(line2, STDOUT) return end  include "b:ratdefn.rtf" # detab - convert tabs to equivalent number of blanks character getc character c integer tabpos integer col, i, tabs(MAXLINE) call initio call settab(tabs) # set initial tab stops col = 1 while (getc(c) ^= EOF) if (c == TAB) repeat { call putc(BLANK) col = col + 1 } until (tabpos(col, tabs) == YES) else if (c == NEWLINE) { call putc(NEWLINE) col = 1 } else { call putc(c) col = col + 1 } call putc(EOF) 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  # entab - replace blanks by tabs and blanks include "b:ratdefn.rtf" character getc character c integer tabpos integer col, i, newcol, tabs(MAXLINE) call initio 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) {call putc(EOF); stop} call putc(c) if (c == NEWLINE) col = 1 else col = col + 1 } call putc(EOF) 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  # example.rtf a simple example of a copy routine define(EOF,-1) define(character,byte) character char character getc call remark("enter outputfile.") call initio while (getc(char)!=EOF) call putc(char) call putc(EOF) stop end #This INCLUDE RATFOR file must not be used in its entirety, #since Microsoft FORTRAN loads all statement functions #whether they are used or not. #This file should be INCLUDEd ahead of the COMMON section of #a RATFOR program #This definition will work in the contexts: # CHARACTER*1 and CHARACTER*2 define(CHARACTER,INTEGER) CHARACTER*1 CHAR REAL LOG,LOG10 #These DATA are in the file CONSTS.RAT which may be INCLUDEd #after the DATA section of a RATFOR program. #DATA KB/3/,KONS/3/ #DATA DPR/.01745329/,RPD/57.29578/ #DATA PI/3.141593/ #These statement functions are on F77LIB which may be searched #at LINK time. #ICHAR(I)=I #CHAR(I)=I #ANINT(X)=AINT(SIGN(.5,X)+X) #NINT(X)=INT(SIGN(.5,X)+X) #LOG(X)=ALOG(X) #LOG10(X)=ALOG10(X) #TAN(X)=SIN(X)/SQRT(1.-SIN(X)**2) #ASIN(X)=ATAN2(X,SQRT(1.-X*X)) #ACOS(X)=ATAN2(SQRT(1.-X*X),X) #SINH(X)=(EXP(X)-1./EXP(X))/2. #COSH(X)=(EXP(X)+1./EXP(X))/2. ASIN(X)=ATAN2(X,SQRT(1.-X*X)) #ACOS(X)=ATAN2(SQRT(1.-X*X),X) #SINH(X)=(EXP(X)-1./EXP(X))/2. #COSH(X include "b:ratdefn.rtf" define(NFILES,4) # include - replace include file by contents of file character line(MAXLINE), str(MAXLINE) integer equal, getlin, getwrd, fopen integer infile(NFILES), len, level, loc # string incl "include" character incl(8) data incl(1) /LETI/ data incl(2) /LETN/ data incl(3) /LETC/ data incl(4) /LETL/ data incl(5) /LETU/ data incl(6) /LETD/ data incl(7) /LETE/ data incl(8) /EOS/ call initio infile(1) = STDIN for (level = 1; level > 0; level = level - 1) { while (getlin(line, infile(level)) ^= EOF) { loc = 1 len = getwrd(line, loc, str) if (equal(str, incl) == NO) call putlin(line, STDOUT) else { level = level + 1 if (level > NFILES) call error("includes nested too deeply.") len = getwrd(line, loc, str) infile(level) = fopen(str, RDONLY) if (infile(level) == ERR) call cant(str) } } if (level > 1) call close(infile(level)) } call putch(EOF,STDOUT) stop end # getwrd - get non-blank word from in(i) into out, increment i integer function getwrd(in, i, out) character in(ARB), out(ARB) integer i, j while (in(i) == BLANK | in(i) == TAB) i = i + 1 j = 1 while (in(i) ^= EOS & in(i) ^= BLANK & in(i) ^= TAB & in(i) ^= NEWLINE) { out(j) = in(i) i = i + 1 j = j + 1 } out(j) = EOS getwrd = j - 1 return end  # msort.rtf - sort lines in memory # # this program allocates both a buffer (linbuf) and pointers into that # buffer (linptr) above then end of the program using ialloc. # note that when words are allocated, 2*LEN+1 must be allocated, the +1 # in case the array address is on an odd word boundary. However, # as long as all of the pointer and buffer manipulations are done in # subroutines, these irregularities disappear by using linbuf(bptr) and # linptr(lptr) as the argument to the subroutine. include "b:ratdefn.rtf" define(MERGEORDER,7) define(NAMESIZE,20) define(MAXTEXT,10000) define(MAXPTR,2000) define(LOGPTR,20) # sort - sort text lines in memory character linbuf(ARB) character argbuf(MAXLINE) character clower integer gtext,ialloc,iaddr, getarg integer linptr(ARB), nlines, lptr, bptr integer isp logical rvflag call initio rvflag = NO if (getarg(1,argbuf,MAXLINE)!=EOF) if (argbuf(1)==MINUS & clower(argbuf(2))==LETR & argbuf(3)==EOS) rvflag = YES else call error("usage: sort [-r].") isp = ialloc(2*MAXPTR+1) # allocating words is more difficult than chars if (isp==NO) call error("cannot allocate memory.") else lptr=(isp+1-iaddr(linptr))/2+1 isp=ialloc(MAXTEXT) if (isp==NO) call error("cannot allocate memory.") else bptr=isp-iaddr(linbuf)+1 if (gtext(linptr(lptr), nlines, linbuf(bptr), STDIN) == EOF) { call quick(linptr(lptr), nlines, linbuf(bptr)) call ptext(linptr(lptr), nlines, linbuf(bptr), rvflag, STDOUT) call putch(EOF,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(ARB) integer getlin integer infile, lbp, len, linptr(ARB), 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, rvflag, outfil) character linbuf(MAXTEXT) logical rvflag integer i, j, linptr(MAXPTR), nlines, outfil if (rvflag == YES) for (i = nlines; i >= 1; i = i - 1) { j = linptr(i) call putlin(linbuf(j), outfil) } else 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  #common blocks referred to by ratfor references #"include ratcomns" #no transliteration tables are required for ascii system #Microsoft FORTRAN requires type statements to precede #common blocks. Initialization is performed according to #the block data module. integer bp #next character in buf character buf #pushed-back characters integer*1 fordep #current depth of for statements character forstk #stack of reinit strings character sdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5), sfor(4),srept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2), vbreak(2),vnext(2),vfor(2),vrept(2),vuntil(2) integer level #level of file inclusion; init=1 integer linect #line count on input file(level); init=1 integer infile #file number(level); infile(1)=stdin integer lastp #last used in namptr; init=0 integer lastt #last used in table; init=0 integer namptr #name pointers character table #text of names & definitions integer outp #last position filled in outbuf; init=0 character outbuf #output collector common/cdefio/bp,buf(bufsize) common/cfor/fordep,forstk(maxforstk) common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept, suntil,vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil common/cline/level,linect(nfiles),infile(nfiles) common/clook/lastp,lastt,namptr(maxptr),table(maxtbl) common/coutln/outp,outbuf(maxline) evel,linect(nfiles),infile(nfiles) common/clook/Xratfor FORTRAN preprocessor 2,0 25-Nov-81.enter files as 'outputfile'.^gS!WD!.WD9C-!ZKO >2U>2!H4!:F-?:o:Hg"ÂÂ!~w+Lw#^~w#nQhhUh!~w+Ž ˆ"#:ͤҶ:aon#2:*"S"Q""!:g, $"#͐  ͺ:g= 2Qgo:( :ͱ#*::g,r >;!j > !4"#"S !j T !4"#"Q !j !!4ͅ#" 0:ʎ *S:*Q:*:*DMxRʞW¬ 2:ʺ 5ú :ʷ !HON2!|2S"N"Q͠W:g, ͗ !|! !*Q#| tD=DNNÆ s>2oͮb!>(-c2U**x_xB!~w++++ .!*Q"**x_"Q> >2S!ͅ#^#ͮ=z#==#:==n#ʁ#>2h2|`@2RATSB2 REL66RATSB2 PRNRATSB2 FORXXdATSB2 FORRELCRFPRN@  Ɉ(Hѐp ꪉʩ52etT9STetU1`h* #`0f @(d#F2zztl:SThꪈ 5|eTD9SPetT1 B3@Xg!Vf~1PhɔLBl outnum(lab) if(.not.(token.eq.-18)) goto 23138 junk = lex(ptoken) call ifgo(lab-1) token = lex(ptoken) call pbstr(ptoken) goto 23139 23138 continue call outgo(lab-1) 23139 continue call outcon(lab+1) return end subroutine whilec(lab) integer labgen integer lab call outcon(0) lab = labgen(2) call outnum(lab) call ifgo(lab+1) return end subroutine whiles(lab) integer lab call outgo(lab) call outcon(lab+1) return end PB:RATSB2=RATSB2 doifelsewhilebreaknextforrepeatuntild error?File not " !" * ~/2 3 * !" * +* ~2 y * +* " * ͧE2 o * * #" 9 !" 2#2#2#2#2#<2#2#)ů2#V+$9+ $ 2*>2#!#-+> 2 $2$2 $y,2#\*:#2#V+$:#i*$9+ $: $2# 2#†*:#@2#!#-+y=7V+ 79+ $* 7!#-+:#!# +!#:#missing left paren.*missing parenthesis in condition.x! X(2M ¢ !N 64! ́)!"K x! X2 <2M : }2a : {2b : ;!b !a !M /2c ! ͇0^: /2M 2 D: (/2M -*K #"K D: )/2M D*K +"K ! ́)*K }=2M ® *K }2M w!d 64.2#̑,$xillegal break.illegal next.-"{"}>!cR*{~#fo"*}=/2¤*)++*}"~#fo}2*~#fo}2*~#fo }2*~#fo}!!!/2š*~#fo}/2…*)++*~#fo#"!(Ù*)++*"*(*+"*~#fo}/2!64!64 #̲,#"x)+~7ȷ> 2-> 2-$%!""%!#:#Ò-"$!" $!#:#-~--<)-<ʼ)!"$'&'!#~-÷- w#-w#.&':#%+t""`i"*DM**2:<2W:a2W*ͤ&}/2 W:/2<*"**ͫ*"B!͇0*DM**2:2a/2p*:"w!"y*y+*w~2{*y+*w"|~Z=Ɓ2{*|~A?!{/2~*y+*w"|~ *|w*y#"yÈ%'do "c*!́)!?$*s#r* )!ͮ'ͱ( " * {(* ~#fo#""!"{(/> ͺ.~¾//7ȷ!0ͫ)@@/> 2-! 0ͫ)_-DISK FULLADD ADIANA ģANA ŦANA ANICALL/CM?CMøCMP ¾CMP CPIDAD )DAD +DCX =DCR 2$3>Ͱ5>2C*yO:Ý2:=P3>Ͱ5>G2C*yO>2:>2C>x2CÛ2:=+3*yO:>2C*{O>2=Ͱ5>Ý2$!"3D=͛:¡3*"""Ì#̈́<2Æ :ʾ3D=B>͞Cif(.not.=missing left paren.invalid for clause.A("o!?$*os#r!{(!sX(2N°!O64!sX;2N!s͇0c*ͱ(!sX;/2N*o{(!s͇0*o )c*!É)!ͮ'!"C*C}2N›!sX2r;/2NBÛ:r(/2N\*C#"Cs:r)/2Ns*C+"C:r_2N:r !N/2b˜!ś)!ͮ'!ͮ'!ͮ'*o~#fo##"c!c(*C}/2N!e64*#"!"A!"?*?*{ozg}/2N+*A"c*cC#*A"A*?#"?*A"c*cw!"C*C}2N!sX2r(/2Nu*C#"CÌ:r)/2NŒ*C+"C:r_2N:r 2b*C}?!b!N/2xy!s%E!sC*A"A@*o~#fo#*os#r() 7+~Ÿ6x="* )!"!"**{ozg}/2[*"*C#*"*#"*"*C}=/2“c**"*́)ͱ(*~#fo+"!(*~#fo#"!{(*+"= 2͊ **"!"!"*+*~2%*+*~og*{ozg*{ozgog"*#"*!Q*"D!͈O"9:7 22x=7>2C2"S*H#"H*S"]!"_*]#"c"K*c"[*F#"F*[)~#fo}/2e·*K*[)~#fo"a"c*c*SB+}/2e*K*_*]"c+!c͈O"]*_#"_*_}=/2e!"K´86 2Ü88:missing left paren.non-alphanumeric name.missing comma in define.definition too long.missing right paren."."0>!2cR*6!> '(2?!@WD*6DM*0*.a2?!SWD*6!> ',2?!iWD!"<!":*<}2?*:*4~#fo{ozg}=/2?`!͆B*:+*2"*6* '</2?‹!͆B*:+*2~(/2?¬*<#"<*:+*2~)/2?*<+"<*:#":"*:++*2"*w:L:0O*N":=ʳ:::aʗ:u~2include<>~includes nested too deeply.>can't open include.""*}=/2"®*)"#*#DM**Ͳ2:<2"}*B}/2"½:*)"#*#DM!Ͳog"*}2"!%64]*)"#"@!m<*@s#r*#"B!*Bs#r*#~#fo###}/2"V!D64]*#"*)"#*#DM**Ͳ2Ñ*+}=/2"¤*)"#*#L*+"_>2"*_*O:aU""`i"*! '<2;: 2: !/28;!0!"*~#fo+"**{ozg}/2º*+*"** '2!ͧE22:a!/2°ú*#"G*~#fo+"**{ozg}2!64*+}=/2( *+*"*0*+*"*w>a2""*~$/2¡ !*"** '(/2i >{*w>{2Þ !*~)/2 >}*w>}2Þ !*"*0""*~"2*~'!/2a!!"*+*"** '*2^!*+*"*~#fo+"**{ozg}?2*~ !/2T!!64*+*"*~*w!^"0^!*#" ""*~#/2“!** ' 2‹!r!> 2""*~~2*~^2*~|2*~&2*~=2*~!2*~<2*~>!!!!!!!/2""*DM*͈1**"*w*~ /2Z"*)"~#fo#*s#r: ? "a"!|"?$*a"s#r*a"͌"?pif(.not.""c*!"́)͆ !"ͮ'!"ͮ'*"() %define@"!""@<*x_:G:D: too many definitions.@""""""*"C#""*"C#""*"f""}2"**"*"$}=!"/2"c##*"D!"WD*")""*#""*"s#r"#*"%E*#*""""#*"%E**"*""">2warning: possible label conflict.:"#*#C}/2#($!*#~32#*#~2!#/2#($!#64*#́)c*ɷ»A*6"Y";$*=$"3$*=$*;$~#fo"=$*3$>2X>>Y*"]!"d$&*d$X /2k$‹$r$*d$~og"\$}2k$*\$}2l$*\$}2m$*\$#}!m$!l$!k$/2n$$*\$*d$ +}/2k$%!"\$À& *d$B+}/2k$:%: og"\$À& *d$B+}/2k$b%: og"\$À& *d$B+}/2k$Š%: og"\$À& *d$B+}/2k$²%: og"\$À& *d$B+}/2k$%: og"\$À& *d$B+}/2k$&: og"\$À& *d$B+}/2k$*&: og"\$À& *d$B+}/2k$R&: og"\$À& *d$B+}/2k$z&: og"\$À&!"\$*\$ Statement CompletioIllegal '"&"&*&f"&)~#fo"&}=2&&!"&*&"&*&C*&"&#"&*&"&&&!%E!"&rect Number of DA"'"'*}=/2'K'*~*'wf'!""'*'*' I*'w*+"*'~2'gal "v'c**v'́):? /2x'›'!'ͮ'ͱ( t of Memor"'*}2'(ͱ(!"'*'}/2'(*'"'> *'w*'#"''>*2!"!"*#""'*'~*'w*'~ /2'd(*+"'l(!'ͽQ"'!*'{ozg*"k(*#"egecontinue"o(*o(~#fo}=/2z((*o( )c*!q(́)ͱ(encIll*"("(> *(w*("(*(w(!D!"!"ategoto "(c*!(́)*( )ͱ(ng Integer QuantitInv" )q) )* )F")!")*)*){ozg}=2)p)*) )")*)ͮ'*)#")8) devicIllegal"t)!"w)*w)+*t)~2{)^**w)+*t)~2v)"2{):v)'!{)/2|))!v)ͮ'T**w)#"w)+*t)"})v)*})KH"y)+")!) )!_*ͮ'*y)+*w)"y)*w)*y){ozg}/2{)T**w)+*t)~2v) /2{)D*> 2v)!v)ͮ'*w)#"w)**w)#"w)Ê)hOM*}/2b*€*!*ͮ' bscriptArray Multiply EQUIVALENCEd Within a GrouMultiple EQUIVALENCE of COMMOCOMMON Base LowereNon-COMMON Variable in BLOCK DATEmpty List for Unformatted WRITNon-Integer ExpressioOperand Mode Not Compatible with OperatoMixing of Operand Modes Not AlloweMissing Integer VariablMissing Statement Number on FORMAZero Repeat FactoZero Format ValuFormat Nest Too DeeStatement Number not FORMAT AssociateInvalid Statement Number UsagNo Path to this StatemenMissing Do TerminatioCode Output in BLOCK DATUndefined Labels Have OccurreRETURN in a Main PrograSTATUS Error on REAInvalid Operand UsagFuillegal else.o Paramstack overflow in parser.Diviillegal right brace.P+,P+,unexpected EOF.;"!",!",!*o$",*,#}2,b0*, }/2,-!N+e"È.*, }/2,±-!N+È.*,}/2,-!N+͖8È.*,}/2,-!N+~È.*,}/2,.!N+͚3È.*, }/2,5.!*#È.*, }/2,ˆ.*,),~#fo }/2,‚.*,)N+",*,RÈ.!,64*,}2,*, }2,*, }2,*,}2,*,}2,*,}2,*, }2,*, }!,!,!,!,!,!,!,/2,“/*,#",}=/2,d/!,͆B*,)",,"-*,*-s#r*,N+"-*N+*-s#rV0*,}/2,/*,),~#fo}/2,/*,+",/!-64;0*,}/2,0!*y';0*, }2,*,}!,/2,;0,-,!,ͧ!*o$",!*͇00-,!,4!*o$",[-*,+}2,|0!4-64M͍X:X*"~0*~0C"0*0}=/200*0+*~0"0*00*0+"0Ó0qNtoo many characters pushed back.:"0*#"}=/201!0͆B*"0*0~*0w?hXNK!O.ge..gt..lt..le..ne..not..eq..and..or.33R*3|3͒33 P3gr3 U3t"&1"(1`i"*1!*&1"^1**1*^1 '=2`11!*&1"^1*^10*&1~>/2`12!*&1~=/2`12*&1"a1a13!/1%E2*&1"e1e13!41%EÄ3*&1~</2`1h2!*&1~=/2`1S2*&1"i1i13!>1%Ee2*&1"m1m13!91%EÄ3*&1~~2`1*&1~^2q1*&1~!!q1!`1/2r12!*&1~=/2`12*&1"s1s13!C1%E2*&1"w1w13!H1%EÄ3*&1~=/2`1(3!*&1~=/2`13*&1"{1{13!N1%E%3!*&1"^1*^1wÄ3*&1~&/2`1N3*&1"113!S1%EÄ3*&1~|/2`1t3*&1"113!Y1%EÄ3!*&1"^1*^1w*&1C*(1s#rQ"y"3!3{(!3?$*3s#r*3{(*3~#fo#*3s#rZQZQx=$Q=-QQx*Q'QQ2o:2>;!0¡Q>;NO*¡Q2:\õberror at line.4"3!%4WD!"!4*!4*{ozg}=234™44!4ZK*!4)"4443*44F"#44!3D*!4#"!4E44!4ZK4!4ZK*3WDQ : 0WR+++"4"4>!4cR*4~#fo+}=/24=7*4~#fo)++*4~#fo}/245=7*4~#fo)++*4"4*4~#fo }24*4~#fo }!4/24i5=7*4~#fo)++*4~#fo }/24¬5*4~#fo)++*4"4*4{(+7*4~#fo)++*4~#fo }/246*4~#fo++}=/245*4~#fo+*4s#r*4~#fo)++*4~#fo#"4!4{(+7*4~#fo)++*4~#fo }/24a6*4~#fo)++*4"4*4$+7*4~#fo)++*4~#fo}/24¤6*4~#fo)++*4"4*48+7*4~#fo)++*4~#fo}/246*4~#fo)++*4"4*4+7*4~#fo)++*4~#fo}/24+7*4~#fo)++*4"4*4*48*4~#fo+*4s#r4!> s#r[#*!s s#r:g+T-T2oe*+!g s#ry!dU&cÅT͠W:O\PmV*y"`!"b*`!g N#F̓R*b"b!> N#F̓Rs#r!s ^#V*ʘU"*!s ^#V">2SW#|ʘU+""?7"A7*?7 )*A7~#fo}/28k8!C7o$" 8*?7~#fo+"8!8͌"!C7o$*A7s#r!C7͇0|8*?7~#fo+"8!8(*?7~#fo#"8!8{(>*2"8!8{(!8?$*8s#r*8 )*8~#fo#"8!8͌"*#|"8*8(*8~#fo#"8!8{(ʫV*w"*B">2SW*k">2SW*:">2SW**u"*@">2SW#|V+">2SW*i">2SW*8">2SW**s"*>">2tty:*.>2SWcannot open standard input.cannot open standard output.2929L29!}/o|/g:8ogg}o}28R;!9WD<*909~>/29;*919"9*9!9ͱB+}29;*919"9P<H<*9͏="9###}29;>29!}/o|/g:8ogg}o}28;!9WD<*909"9:929*9~ !9/29<<*9#"9<::9/291<:828:9/29G<:828Z:05ZcYtty:]"[<"]<*[2f"Z‹Z*\*"\*Z">cannot allocate buffer.ZZ> "<=">=`i"@=*>=~2b=*@=~#fo8~@@2k=W>!?IO"`=}/2k==!l=WD*<=A!"4=*@=~#fo8"=~@*=w*@=~#fo)8"=!8͂O"=!*={ozg*`=*=s#r*@=~#fo)"=9"=*=8~#fo*=s#r=B=*<=ʹ?:b=/2k=ª>=B=*@=O"4=*@=~#fo)"=9"=*=8~#fo+*=s#r2?:b==/2k=>=B=*@=O"4=*@=~#fo)"=9"=*=9~#fo*=s#r2?:b=/2k=2?=B=*@=O"4=*@=~#fo)"=9"=*=9~#fo*=s#r*4=}/2k=M?!"4=*@=~#fo8"=!}/o|/g*=~ogg}o}*=w*@=~#fo8"=:b=*=*=w*@=~#fo"4=(]!:wF\^F\*"?"?`i"?!"??*?ͣH2?*?+*?"?~'2?*?~"!?/2?@*?+*?~2?*?#"?*?*?~:/2?T@*?+*?"?*?@Fog!*?s#r*?##"?^@!*?s#r!"?*?}=2?˜@*?+*?"?> *?w*?#"?d@!"?*?+*?"?*?ͧE2?*?ͧEa!?/2?A*?}=/2?@A*?+*?"?*?+*?"?*?͆F*?w*?#"?*?#"?Þ@*?+*?~./2?A*?#"?! "?*?+*?"?*?ͧE2?*?ͧEa!?/2?A*?}=/2?AA*?+*?"?*?+*?"?*?͆F*?w*?#"?*?#"?BA! *?"?*?wO : can't open."AB!BZKB*AD!A͆B W>;*| 6a"*""B"B!"B*B+"B*B"B*B*B"B*B~*B/2B|B*B+*B~/2BrB!"B*B#"B)B!"B2"B*BWDO ."**",8`***,"B"B!"B!"B*B+*B~2BC*B+"B*B"B*B*B"B*B@F2B*B@F!B2BC*B*B#"BB!"B6a*w"rc"-C"/C!"1C*/C!4C I<25CŠC*1C+*-C"6C:4C*6Cw:4C /25C€CÊC*1C#"1CEC:4C</25C±C*1C+*-C"6C*6Cw!"%C*1C*-C"6C*6Cw*1C"%Caa"#:a"C!"C*C*C~2CC*C#"CC*C]!a6X"C"D!"D*D+*C~2DID*D+*C"D*D*DZK*D#"DD"KD!"OD*OD+*KD"SD~2UD*SD~.!UD/2VD¨D*OD+*KD~2NDD!NDZK*OD#"OD`DD!DZK "D!"D*D+*D"D~2D*D~.!D/2DE*D+*D~2DE!DZK*D#"DD"E"E>!EcR*E~#fo" E*E~#fo"E*E+*E~2"E‡E* E+*E"#E*E+*E~*#Ew* E#" E*E#"EHE* E+*E"#E*#Ew"E*E~z=Ɓ2E*E~a?!E/2EE>a2E/F*E~Z=Ɓ2E*E~A?!E/2EE>a2E/F*E~9=Ɓ2E*E~0?!E/2E(F>2E/F*E~2E:E"F*F/2?FuF*-*Fw*F+"F!"F*F*F{ozg}/2F7H*F+*F"F~og"F*F+"F*F~*Fw*F*F"F:F*Fw*F+"F*F#"FG*F "FH"HH!">H*>H+*FH~2JH“H*>H+*FH~*HH/2JH‰H*>H*>H#">HXH!">H"H"H*H~#fo+*H"H~ 2H*H~ !H/2HH*H~#fo#*Hs#rêHcannot read channel."H"H*H~#fo8~2H2H*H~#fo}!H/2H£I*HN*Hw~/2HzI>*Hw*H~ /2H‘I> *Hw*H~2?*H~2HíJ:H/2HI!HWD>*Hw~2HíJ*H~#fo)"I9~#fo"I*I8~#fo"I*I9~#fo"I*I*I{ozg}2H|J:Hր/2H0J>*HwíJ*I8"I*HDMBK*IP"I}2HgJ:H2H*I+"I*I*I"II*I#"I8~*Hw~ /2HŸJ*Hw*H~2HI*H~ /2HJ> *Hw*H~/2HJ>*Hw*I"I:H2H*H~2?*H~2H*H~#fo)9"I*I*Is#r*H~#fo)9"I*I*Is#r*H~#fo8"I:H*Iw:H ;!b !a !M /2c "EK"GK*EK~</2LKwK>*EKw*GK~#fo8~2IK2LK*GK~#fo}!LK/2MKK*EK~2LKK*EK~ /2LKK!L *EKw*GK~#fo)"TK9~#fo"NK*TK8~#fo"PK*TK9~#fo"RK*NK*RK{ozg}2LKaL*PK8"TK*GKDML*TK-P"VK*PK+"NK*NK#"NK*GK~#fo)9"TK*NK*TKs#r*NK8"XK*EK~*XKw*EK~ /2LK­L> *EKwK*EK~/2LKL*GKL }"L*L~#fo}/2LL*L~#fo8"L!}/o|/g*L~ogg}o}*Lw*L~#fo8~/2L0M*L~#fo8~/2LQM*L͘M*LO*L~#fo8"L!}/o|/g*L~ogg}o}*Lw2:2a"M*M~#fo8~2M*M~#fo}!M/2MM*M~#fo)"M9~#fo"M*M8~#fo"M*M9~#fo"M!*M{ozg*M"M!Q)))))))"M+*M"M*M#"M*M*M{ozg}=2MmN*M8"M*Mw*M#"M6N*M8"M*MDMM*M-P"M*M~#fo)9"M*M*Ms#rNP! : _2: ,!/2!B 2!B: _/:NO*N#"N:N=2N~wN  !N"N#:N_6 <2N^~#fo*ODM!9zO tO tO!"O}/o|/g#!9~#fo~#fo{ozg~#fo~#fo{ozg3U(͹Q~#fo{2CPOXQDP~#fo{2CPOsQDP~͝QDP~#fo 2CPP*PDP}o|g~#fo 2CPQDP!OP&! ERROR -$ ON FILE$!sxP~#fo!OՇ_2OpP|§P!OIO|P:OxPs#r(>P #w#³P wnQw#PpP Q!>NQxPQQ>7pPFQ>NQ!yQQQ> 7/ 7̓P/Q/ʕQ> 7pP/ʳQ> 7ɯ$Rz||QRzQzBR|G||R/RRR~#fo|RɯO_yW!)U~/woG}_}W}O~#fo~#fo|/G}/O!>JR IR7>{_zW}o|g=@R|g}o`iN#F#q#p#=fR2+T"U"U`i",T2.T:.TҞR!U_òR:+T*,TڷR_~#fo:.T<2.TW:+TR=/2~#O!)S ^#V"R!R6 #6 #6*#6*###6*#6*#6 #6 !R ~S# S:eS<2eSSSIDF0MPIRFWITEXDOMLDZLGSQIBTLOBDEISBEINOVCNGLGSSNA2IODTBIRCEF2eS2fS!|S"}S*+`iɔS!S*}S> S> SP +}/2e*K"."0>!2*6!>(2?!@*6DM*0*.aS_*S~ T#~"S S!S^#6 #> Sw2?*:*4~#fo{ozg}=2?!*:+*2"*6*</2?!*:+*2~(/2?*<#"<*:+*2~)""*}=/2"*)"#*#DM**2:<2"*}/2":*)"#*#DM*2~)""*}=/2"*)"#*#DM**2:<2"SUSdD8IOCOM(d5D4py%`PZ`x@f!x4`s֍` |^2 v@ Z@|e U@?2" V;R@  GOg|eX"Ou)S Xln8CdE@aXaV?5` |C[Va dEXx*À * aV2 v* aXdF#>֮cѬO݄#,!y^guԔ4o #9Fo>  ˈ fqtSpt0@i7AtCŸb@&?`d5)x -@xdE@Xd! +>֮cѬO݄ GDXd@Vf` g:Z5)[e @^o> @ tDg>їaqn7΂ynΆqr2 StK@@8]f?31`",2: ` |eXd5)[ Xlnv$b`1yXF" :13`>/aA)ip@ X5)x -@낀=. 1ad@&8 誉)ќp)Ȉ(2T#& MR3$Г YI5I.c|M]%9%Q%>pQSTdT8IOCOM`XKC-`X 3@Ys֍` |^2 v!X1!,2* 2}\O݄ F IOCOM,0a :1[a 0xU@X4B^sփֱ>/a`h&1*`V f,#ϠukS[V f0 XU@2xFMATCHрd4CANTG@*2z*td48IOCOM`X ",*`/`o)i2~s>2 v!@W1h,pan7ac0 f2p9f/2f(~e؀*qV ?HGDYHC€*@ X*ҦpbˬUb3fcxEU@31#",:`)-YH*" Be")F{*z*rd$&'`*J ""ĸe$T$ʈCANTT4騀t''!'NPSӠT4u"E@84U@eX4V`ȋv>2 ~k-,$a+ud2@#` 8:X2~ke@ U@nV x3@x]>guTˬU@b3b,&. *1c<!X,U/WdZAXa`[U",> xUb,ö`"`+udEX<5M` |e@X<~>! ax -@^sփֱ>/aaѐ b`V X2"`&X<*1 `0PU@nV >/a`A  `[U@",* 5)`mkZ-,$az':ZZe@ o@f:"+udEX4V`ȋ 6xU@b,*`1 a B :X 2" V;ej Q0 ihIsQ(CANONS D4Ah 3@ pt 1Msp2Pf @4UUD48( )ё 5 D4IQTUPS TUT uX`V xU@","*V XL,,*a+uHd,*aE@3V hLN 2eVpEQUALQTԠTU%$!`h@ FA2*j \d()MD#II=JpQ`Td4u:8ϠukS,aPhàVu@hɔ,FC2:*bJtd(*&$FM*DG@*2zPU ddD4 uX`"+uHdX@nX8V" V :X,2" *X@UC` |e U@3VpLI@ 2e 5sddD4UTdtUD$xCTLCOM`X ",!X\Ba0ji GO` |^2` v* dEaaV?5g|C[VU@317sj?e Lb&,&?5M` |eXp)[ XxnXLE<2"8!bX3@U",&&6& akXX@8xL!` ax-@ XLU?2~axXL#",8*`{2}\\~aV?5)[ Xxn£Vȋ E^ @W1hXlU` |C[VdcU,2*`aXDXlUa;Xe U?2~aVaPVuhFf7Ҧp}\]>/aa0 XhO pYOp^2 vþ3!VX,2"À4*ÀqV XTvf$ L0c|!XTU@b~紩3@W1hOXlnXL#'kS,6:@ `KXak-8ll/b0a) baa XLU@b,*êS`)@ baxXTV" A gX""FI@2Zbr\ה :UTUDtUD1 X( TtUD4 5DtUD9USdtUDĔ uX`V up45)[V X$2"@ *@qke@ H&(`#` OXDnX4V`ȋ +XH!X1_`XDXH^*@qV `LP2*QU& 8S dTuD ,* V -@XB@&#@ɔMJ#19Q"pUPeUDDT1u`0X3@LL2$US&!`\:UPUS eUDAu"#XEXL*`{JI9sփֱ>2 v*XLF"` :>1?@,&*`V=MZAXapa0 :X`R@XLF"` :1wd&!dX$'b*D@G@2JrUEUD120PPUTCHPPUTCUSeUDĔu`PVX2~kS,a +udEX * U@b, áL(2jTU&@ 8SPTe$T$@, *XDX$X,U@as0e U@nV X"p 4`P0Hļ#O 62e 2TU&*|:SPTT e$A@, *XDXX$Uas0e U@nV X"p 4`P0Hļ( P 5Te$IT`U44u! U31EX #3X$U@nV -@ b `V X2~`X,U@b,ä`PV X2" V;eH5tU44T`EEQ `X=c S,* 汄.?OpX^2 v>0 HZ) `X8,L/`FXLS@X$X H0 `݄C,&.~` TbV: @h0:TgT4U41 uXfcx* XX@nX,#3nV XLGX,#3b?5)x-@2 0b*`#uXFrubaVf csX݄C,&/~XDXDU@tkS[$e@`ƨU31V`e@&6@p u@20CLOWERG@*Td4tU! ` HZ) `X8,L/``@2 d@&  8TTd5UU! ` Hz) `X8,L/``x]>gu\e@&%@ɔMP# UAAJp`D5D uXfcx* ?5-` |eX85)[ XDnX,#3nV 9L:13,*`+uHdX@nX,#3nV X49`.e@ X&2 "]co `oX,#90hLU@2 $M9G@"zLUDD1 uX"X\^*`q" *#aP! EXTV`ȋ D` EXt*(X\U@b~紩3@W1hX|UukS>݅HXT*{JI9sցt HFf7@W1hOp^2 v* 1X,2"àh8@*+`" 2aPTzNϠu ,>a*+uXdE@|"`2+bXO¬:wbXDXuX* a 08U@2PȀIABS4I@(Sd3U ITOCRSV TDU uX`VX$2~kS,a+uHd*` f>/``LU@b,á" @p<:RSV'Гe4$ufcx* ?5-` |eX5)[ X nX #3nV9L:13d@& 8QU TtUD4NXTCOM#T4 uXfcxF IOCOM9`#XaV ?j?-,$aX$~ke@ |`HU@`kX݄Bw He',*!V ? %LNX@kS[ pn7΂dqlKd8Lw? %Ld@X,#3",ZRSyd#3XU@<$2~,R*Š:?+bpXҦp}\]>2 v:dY,"a`U@<$2"ŠD&@V-f,^?':Z5)[{ X@bz* 'bXDXv@&>`N#bp X$~kZe@ ^* y-WdcJ1H kS[(U@V ?5M` |^2 v>HUXuـHe',*!V ? fcx#ȋ 8U@b3fcx#@",b*`V19B~c0c02e`@誊1p 1 &Q 8TU UUD48IOCOM`X x,aЫ"~5%= =7O, 5` |eX #3ϠukSH݄ kS,a~ke B3@ 3kŀ1P`X,ah1~Ff7PxHd#3X0UV;Ff7d)x-@&b* 5)x-@3@ 3@V? >y*x]>gQϪ3yU@0e&*Fa@2bz,:PgQT TdU48IOCOM`V?'0kS,* }\Xe 13`oxGO31EX<#@'"o`p `PTzNb`XfHR)DX4V`Pȋ EX *3@W1h=k,a WxUb,óVȋ XDU@31R `0X g<3ԒUQ0@ jɊiURSdtUEEEAUQQQfP5Q`0\-rݙFXF"=`0rX3@(f@ `<`0jK4 `\,GETTTYeUEEEPSd8%JISPVALMO31*Bhem1r[T.eJ.p0}ς8Ld&,N@*J ""t$&'N2J dPSԠDH %=JP5 fc{#3jSyHgdfc{#3kSyhgd@"J r$t@NLd&,N@*J ""t$&'N2J dPSԠDH %=JP5 fc{#3jSyHgdfc{#3kSyhgd@"J r#========= translit program from chapter 2 ========== include "b:ratdefn.rtf" define(MAXARR,100) define(MAXSET,100) define(ESCAPE,ATSIGN) define(DASH,MINUS) define(NOT,BANG) # addset - put c in set(j) if it fits, increment j integer function addset(c, set, j, maxsiz) integer j, maxsiz character c, set(maxsiz) if (j > maxsiz) addset = NO else { set(j) = c j = j + 1 addset = YES } return end # dodash - expand array(i-1)-array(i+1) into set(j)... from valid subroutine dodash(valid, array, i, set, j, maxset) character esc integer addset, index integer i, j, junk, k, limit, maxset character array(ARB), set(maxset), valid(ARB) i = i + 1 j = j - 1 limit = index(valid, esc(array, i)) for (k = index(valid, set(j)); k <= limit; k = k + 1) junk = addset(valid(k), set, j, maxset) return end # esc - map array(i) into escaped character if appropriate character function esc(array, i) character array(ARB) integer i if (array(i) ^= ESCAPE) esc = array(i) else if (array(i+1) == EOS) # \*a not special at end esc = ESCAPE else { i = i + 1 if (array(i) == LETN) esc = NEWLINE else if (array(i) == LETT) esc = TAB else esc = array(i) } return end # filset - expand set at array(i) into set(j), stop at delim subroutine filset(delim, array, i, set, j, maxset) character esc integer addset, index integer i, j, junk, maxset character array(ARB), delim, set(maxset) # string digits "0123456789" character digits(11) # string lowalf "abcdefghijklmnopqrstuvwxyz" character lowalf(27) # string upalf "ABCDEFGHIJKLMNOPQRSTUVWXYZ" character upalf(27) data digits(1)/DIG0/, digits(2)/DIG1/, digits(3)/DIG2/ data digits(4)/DIG3/, digits(5)/DIG4/, digits(6)/DIG5/ data digits(7)/DIG6/, digits(8)/DIG7/, digits(9)/DIG8/ data digits(10)/DIG9/, 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/ for ( ; array(i) ^= delim & array(i) ^= EOS; i = i + 1) if (array(i) == ESCAPE) junk = addset(esc(array, i), set, j, maxset) else if (array(i) ^= DASH) junk = addset(array(i), set, j, maxset) else if (j <= 1 | array(i+1) == EOS) # literal - junk = addset(DASH, set, j, maxset) else if (index(digits, set(j-1)) > 0) call dodash(digits, array, i, set, j, maxset) else if (index(lowalf, set(j-1)) > 0) call dodash(lowalf, array, i, set, j, maxset) else if (index(upalf, set(j-1)) > 0) call dodash(upalf, array, i, set, j, maxset) else junk = addset(DASH, set, j, maxset) return end # makset - make set from array(k) in set integer function makset(array, k, set, size) integer addset integer i, j, k, size character array(ARB), set(size) i = k j = 1 call filset(EOS, array, i, set, j, size) makset = addset(EOS, set, j, size) return end # translit - map characters character getc character arg(MAXARR), c, from(MAXSET), to(MAXSET) integer getarg, length, makset, xindex integer allbut, collap, i, lastto call initio if (getarg(1, arg, MAXARR) == EOF) call error("usage: translit from to.") else if (arg(1) == NOT) { allbut = YES if (makset(arg, 2, from, MAXSET) == NO) call error("from: too large.") } else { allbut = NO if (makset(arg, 1, from, MAXSET) == NO) call error("from: too large.") } if (getarg(2, arg, MAXARR) == EOF) to(1) = EOS else if (makset(arg, 1, to, MAXSET) == NO) call error("to: too large.") lastto = length(to) if (length(from) > lastto | allbut == YES) collap = YES else collap = NO repeat { i = xindex(from, getc(c), allbut, lastto) if (collap == YES & i >= lastto & lastto > 0) { # collapse call putc(to(lastto)) repeat i = xindex(from, getc(c), allbut, lastto) until (i < lastto) } if (c == EOF) { call putc(EOF) break } if (i > 0 & lastto > 0) # translate call putc(to(i)) else if (i == 0) # copy call putc(c) # else delete } stop end # xindex - invert condition returned by index integer function xindex(array, c, allbut, lastto) character array(ARB), c integer index integer allbut, lastto if (c == EOF) xindex = 0 else if (allbut == NO) xindex = index(array, c) else if (index(array, c) > 0) xindex = 0 else xindex = lastto + 1 return end  include "b:ratdefn.rtf" # unique - strip adjacent duplicate lines character buf1(MAXLINE), buf2(MAXLINE) integer equal, getlin, getarg integer t, n, nflag call initio nflag = NO if (getarg(1, buf1, MAXLINE) ^= EOF) if (buf1(1) == MINUS & (buf1(2) == LETN | buf1(2) == BIGN) & buf1(3) == EOS) nflag = YES else call error("usage: unique [-n].") t = getlin(buf1, STDIN) while (t ^= EOF) { n = 1 for (t = getlin(buf2, STDIN); t ^= EOF; t = getlin(buf2, STDIN)) if (equal(buf1, buf2) == NO) break else n = n + 1 if (nflag == YES) { call putdec(n, 5) call putch(TAB, STDOUT) } call putlin(buf1, STDOUT) if (t == EOF) break n = 1 for (t = getlin(buf1, STDIN); t ^= EOF; t = getlin(buf1, STDIN)) if (equal(buf1, buf2) == NO) break else n = n + 1 if (nflag == YES) { call putdec(n, 5) call putch(TAB, STDOUT) } call putlin(buf2, STDOUT) } call putch(EOF, STDOUT) stop end  # wordcount - count words in standard input define(EOF,-1) define(YES,1) define(NO,0) define(BLANK,32) define(NEWLINE,10) define(TAB,9) define(character,byte) character getc character c integer inword, wc call initio wc = 0 inword = NO while (getc(c) != EOF) if (c == BLANK | c == NEWLINE | c == TAB) inword = NO else if (inword == NO) { inword = YES wc = wc + 1 } call putdec(wc, 1) call putc(NEWLINE) call putc(EOF) stop end