programratfor callinitio callparse callcloso callexit end subroutinesynerr(msg) integermsg(81) integeritoc integeri common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf callremark(14herror at line.) i=1 continue 23000 continue calloutnum(linect(i)) i=i+1 23001 if(.not.(i.gt.level)) goto 23000 23002 continue calloutch(58) calloutch(13) calloutch(10) type10,(linect(i),i=1,level) 10 format(5i7,1h:) callremark(msg) return end subroutineremark(buf) bytebuf(100) integer*2i,length,wbuf(60) continue length=1 23003 if(.not.(buf(length).ne.0)) goto 23005 wbuf(length)=buf(length) 23004 length=length+1 goto 23003 23005 continue wbuf(length)=10002 calloutstr(wbuf) length=length-1 type10,(buf(i),i=1,length) 10 format(1h ,80a1) return end subroutineputch(c) integerc integerwcnt common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf if(.not.(obufp.ge.obuff+osize)) goto 23006 wcnt=osize/2 ostat=iwritw(wcnt,obuf(obuff),oblk,ochan) if(.not.(ostat.le.-1)) goto 23008 callferror(16hputch: write err) 23008 continue obufp=obuff oblk=oblk+ostat/256 23006 continue obuf(obufp)=c obufp=obufp+1 return end subroutineparse common/cstack/sp integer*2sp integerlexstr(200) integerlex integerlab,labval(100),lextyp(100),token callinitkw sp=1 lextyp(1)=10003 continue token=lex(lexstr) 23010 if(.not.(token.ne.10003)) goto 23012 if(.not.(token.eq.10261)) goto 23013 callifcode(lab) goto 23014 23013 continue if(.not.(token.eq.10266)) goto 23015 calldocode(lab) goto 23016 23015 continue if(.not.(token.eq.10263)) goto 23017 callwhilec(lab) goto 23018 23017 continue if(.not.(token.eq.10268)) goto 230 *19 callforcod(lab) goto 23020 23019 continue if(.not.(token.eq.10269)) go *to 23021 callrepcod(lab) goto 23022 23021 continue if(.not.(token.eq.10260)) * goto 23023 calllabelc(lexstr) goto 23024 23023 continue if(.not.(token.eq.10262) *) goto 23025 if(.not.(lextyp(sp *).eq.10261)) goto 23027 callelseif(labv *al(sp)) goto 23028 23027 continue callsynerr(1 *3hillegal else.) 23028 continue 23025 continue 23024 continue 23022 continue 23020 continue 23018 continue 23016 continue 23014 continue if(.not.(token.eq.10261.or.token.eq.10262.or.token.eq.10263. *or.token.eq.10268.or.token.eq.10269.or.token.eq.10266.or.token.eq. *10260.or.token.eq.123)) goto 23029 sp=sp+1 if(.not.(sp.gt.100)) goto 23031 callerror(25hstack overflow in parser.) 23031 continue lextyp(sp)=token labval(sp)=lab goto 23030 23029 continue if(.not.(token.eq.125)) goto 23033 if(.not.(lextyp(sp).eq.123)) goto 230 *35 sp=sp-1 goto 23036 23035 continue callsynerr(20hillegal right brace.) 23036 continue goto 23034 23033 continue if(.not.(token.eq.10267)) goto 23037 callotherc(lexstr) goto 23038 23037 continue if(.not.(token.eq.10264.or.token.eq.102 *65)) goto 23039 callbrknxt(sp,lextyp,labval,token) 23039 continue 23038 continue 23034 continue token=lex(lexstr) callpbstr(lexstr) callunstak(sp,lextyp,labval,token) 23030 continue 23011 token=lex(lexstr) goto 23010 23012 continue if(.not.(sp.ne.1)) goto 23041 callsynerr(15hunexpected EOF.) 23041 continue return end subroutineouttab common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf common/cstack/sp integer*2sp if(.not.(outp.lt.7)) goto 23043 calloutch(9) outp=6 continue i=2 23045 if(.not.(i.le.sp)) goto 23047 calloutch(32) calloutch(32) calloutch(32) 23046 i=i+1 goto 23045 23047 continue goto 23044 23043 continue outp=outp+8 calloutch(9) 23044 continue return end subroutineoutstr(str) integerc,str(100) integeri,j,k continue i=1 23048 if(.not.(str(i).ne.10002)) goto 23050 c=str(i) if(.not.(c.ne.39.and.c.ne.34)) goto 23051 calloutch(c) goto 23052 23051 continue i=i+1 continue j=i 23053 if(.not.(str(j).ne.c)) goto 23055 23054 j=j+1 goto 23053 23055 continue calloutnum(j-i) if(.not.(str(j+1).eq.114)) goto 23056 calloutch(114) k=j+1 goto 23057 23056 continue calloutch(104) k=j 23057 continue continue 23058 if(.not.(i.lt.j)) goto 23060 calloutch(str(i)) 23059 i=i+1 goto 23058 23060 continue i=k 23052 continue 23049 i=i+1 goto 23048 23050 continue return end subroutineoutdon common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf callputch(13) callputch(10) outp=0 return end subroutineoutch(c) integerc integeri common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf if(.not.(outp.ge.72)) goto 23061 calloutdon callputch(9) callputch(42) outp=6 23061 continue outp=outp+1 if(.not.(c.eq.92)) goto 23063 c=34 23063 continue callputch(c) return end subroutineopeno(dblk,length) integer*2dblk(4),length,i common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf ochan=igetc() if(.not.(ochan.le.-1)) goto 23065 callferror(16hopeno: igetc err) 23065 continue i=ienter(ochan,dblk,length) if(.not.(i.lt.0)) goto 23067 callferror(17hopeno: ienter err) 23067 continue return end integerfunctionopenio(name) integername(30) bytebname(30) integer*2chan,i,wcnt,blkn integer*2filspc(39),deftyp(4) integer*2r50rfi,device datadeftyp/4*3rRFR/ datar50rfi/3rRFI/ common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf chan=igetc() if(.not.(chan.le.-1)) goto 23069 callferror(17hopenio: igetc err) 23069 continue continue i=1 23071 if(.not.(name(i).ne.10002)) goto 23073 bname(i)=name(i) 23072 i=i+1 goto 23071 23073 continue bname(i)=0 if(.not.(level.gt.0)) goto 23074 deftyp(1)=r50rfi 23074 continue i=icsi(filspc,deftyp,bname,,0) if(.not.(i.ne.0)) goto 23076 callferror(16hopenio: icsi err) 23076 continue if(.not.(level.eq.0)) goto 23078 device=filspc(16) goto 23079 23078 continue filspc(16)=device 23079 continue callr50asc(12,filspc(16),bname) type10,(bname(i),i=1,12) 10 format(20h file being opened: ,3a1,1h:,6a1,1h.,3a1) i=lookup(chan,filspc(16)) if(.not.(i.le.0)) goto 23080 callferror(18hopenio: lookup err) 23080 continue inbufb=inbufb+2*insize inbuff(level+1)=inbufb inbufe(level+1)=inbufb+insize inbufp(level+1)=inbufb+insize wcnt=insize/2 blkn=0 instat(level+1)=iread(wcnt,inbuf(inbufe(level+1)),blkn,chan) blk(level+1)=0 openio=chan return end integerfunctionlook(name,defn) integerdefn(200),name(200) integeri,j,k common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf continue i=lastp 23082 if(.not.(i.gt.0)) goto 23084 j=namptr(i) continue k=1 23085 if(.not.(name(k).eq.table(j).and.name(k).ne.10002)) *goto 23087 j=j+1 23086 k=k+1 goto 23085 23087 continue if(.not.(name(k).eq.table(j))) goto 23088 callscopy(table,j+1,defn,1) look=1 return 23088 continue 23083 i=i-1 goto 23082 23084 continue look=0 return end subroutineinitio integer*2name(30),openio integer*2filspc(39),deftyp(4),ier,i,pos1 bytecstrng(81),prompt(2) equivalence(cstrng,inbuf(1)),(filspc,obuf(83)),(name,obuf(171)) datadeftyp/3rRFR,3rFOR,3rLST,3rDAT/ dataprompt/1h*,128/ common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf insize=512 inbufb=1-2*insize continue 23090 continue callgtlin(cstrng,prompt) if(.not.(cstrng(1).eq.0)) goto 23093 type20 20 format(15h ratfor v01.00 /) 23093 continue 23091 if(.not.(cstrng(1).ne.0)) goto 23090 23092 continue continue i=1 23095 if(.not.(cstrng(i).ne.0)) goto 23097 name(i)=cstrng(i) 23096 i=i+1 goto 23095 23097 continue name(i)=10002 pos1=index(name,1h=)+1 level=0 infile(1)=openio(name(pos1)) level=1 osize=512 obuff=1 obufp=1 oblk=0 ier=icsi(filspc,deftyp,cstrng,,0) if(.not.(ier.ne.0)) goto 23098 callferror(31hinitio: ill icsi command string) 23098 continue callopeno(filspc(1),filspc(5)) return end integerfunctiongtok(lexstr,toksiz,fd) integerngetch,type integerfd,i,toksiz integerc,lexstr(toksiz) common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf continue 23100 if(.not.(ngetch(c,fd).ne.10003)) goto 23101 if(.not.(c.ne.32.and.c.ne.9)) goto 23102 goto 23101 23102 continue goto 23100 23101 continue callputbak(c) continue i=1 23104 if(.not.(i.lt.toksiz-1)) goto 23106 gtok=type(ngetch(lexstr(i),fd)) if(.not.(gtok.ne.1.and.gtok.ne.2)) goto 23107 goto 23106 23107 continue 23105 i=i+1 goto 23104 23106 continue if(.not.(i.ge.toksiz-1)) goto 23109 callsynerr(15htoken too long.) 23109 continue if(.not.(i.gt.1)) goto 23111 callputbak(lexstr(i)) lexstr(i)=10002 gtok=10100 goto 23112 23111 continue if(.not.(lexstr(1).eq.36)) goto 23113 if(.not.(ngetch(lexstr(2),fd).eq.40)) goto 231 *15 lexstr(1)=123 gtok=123 goto 23116 23115 continue if(.not.(lexstr(2).eq.41)) goto 23117 lexstr(1)=125 gtok=125 goto 23118 23117 continue callputbak(lexstr(2)) 23118 continue 23116 continue goto 23114 23113 continue if(.not.(lexstr(1).eq.39.or.lexstr(1).eq.34)) *goto 23119 continue i=2 23121 if(.not.(ngetch(lexstr(i),fd).ne.lexstr(1))) * goto 23123 if(.not.(lexstr(i).eq.10.or.i.ge.toksiz-1)) * goto 23124 callsynerr(14hmissing quote.) lexstr(i)=lexstr(1) callputbak(10) goto 23123 23124 continue 23122 i=i+1 goto 23121 23123 continue i=i+1 if(.not.(ngetch(lexstr(i),fd).eq.82)) go *to 23126 lexstr(i)=114 23126 continue if(.not.(lexstr(i).ne.114)) goto 23128 callputbak(lexstr(i)) i=i-1 23128 continue goto 23120 23119 continue if(.not.(lexstr(1).eq.35)) goto 23130 continue 23132 if(.not.(ngetch(lexstr(1),fd).ne.10)) * goto 23133 goto 23132 23133 continue gtok=10 goto 23131 23130 continue if(.not.(lexstr(1).eq.62.or.lexstr(1).eq.6 *0.or.lexstr(1).eq.33.or.lexstr(1).eq.61.or.lexstr(1).eq.38.or.lexs *tr(1).eq.124)) goto 23134 callrelate(lexstr,i,fd) 23134 continue 23131 continue 23120 continue 23114 continue 23112 continue lexstr(i+1)=10002 if(.not.(lexstr(1).eq.10)) goto 23136 linect(level)=linect(level)+1 23136 continue return end integerfunctiongettok(token,toksiz) integerequal,openio integerjunk,toksiz integerdeftok integername(30),token(toksiz) common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf integerincl(8) dataincl(1)/105/ dataincl(2)/110/ dataincl(3)/99/ dataincl(4)/108/ dataincl(5)/117/ dataincl(6)/100/ dataincl(7)/101/ dataincl(8)/10002/ continue 23138 if(.not.(level.gt.0)) goto 23140 continue gettok=deftok(token,toksiz,infile(level)) 23141 if(.not.(gettok.ne.10003)) goto 23143 if(.not.(equal(token,incl).eq.0)) goto 23144 return 23144 continue junk=deftok(name,30,infile(level)) if(.not.(level.ge.5)) goto 23146 callferror(27hincludes nested too deeply.) goto 23147 23146 continue infile(level+1)=openio(name) linect(level+1)=1 level=level+1 23147 continue 23142 gettok=deftok(token,toksiz,infile(level)) goto 23141 23143 continue if(.not.(level.gt.1)) goto 23148 callclosio(infile(level)) 23148 continue 23139 level=level-1 goto 23138 23140 continue gettok=10003 return end integerfunctiongetch(c,f) integerc integerwcnt,blkn,chan,itemp common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf continue 23150 continue if(.not.(inbufp(level).ge.inbuff(level)+insize)) got *o 23153 wcnt=insize/2 chan=infile(level) i=iwait(chan) if(.not.(i.ne.0)) goto 23155 callferror(15hgetch: wait err) 23155 continue if(.not.(instat(level).le.-2)) goto 23157 callferror(15hgetch: read err) 23157 continue if(.not.(instat(level).eq.-1)) goto 23159 c=10003 getch=10003 return 23159 continue if(.not.(instat(level).lt.wcnt)) goto 23161 inbuf(inbufe(level)+2*instat(level))=10003 23161 continue itemp=inbuff(level) inbuff(level)=inbufe(level) inbufe(level)=itemp inbufp(level)=inbuff(level) blk(level)=blk(level)+instat(level)/256 blkn=blk(level) instat(level)=iread(wcnt,inbuf(inbufe(level)),blkn,cha *n) 23153 continue getch=inbuf(inbufp(level)) inbufp(level)=inbufp(level)+1 23151 if(.not.(getch.eq.10003.or.(getch.ne.0.and.getch.ne.13))) * goto 23150 23152 continue getch=intran(getch) c=getch return end subroutineferror(msg) integer*2length bytemsg(81) length=len(msg) type10,(msg(i),i=1,length) 10 format(1h ,80a1) callexit return end integerfunctiondeftok(token,toksiz,fd) integergtok integerfd,toksiz integerdefn(200),t,token(toksiz) integerlook continue t=gtok(token,toksiz,fd) 23163 if(.not.(t.ne.10003)) goto 23165 if(.not.(t.ne.10100)) goto 23166 goto 23165 23166 continue if(.not.(look(token,defn).eq.0)) goto 23168 goto 23165 23168 continue if(.not.(defn(1).eq.10010)) goto 23170 callgetdef(token,toksiz,defn,200,fd) callinstal(token,defn) goto 23171 23170 continue callpbstr(defn) 23171 continue 23164 t=gtok(token,toksiz,fd) goto 23163 23165 continue deftok=t if(.not.(deftok.eq.10100)) goto 23172 callfold(token) 23172 continue return end subroutinecloso integerptr,wcnt common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf if(.not.(obufp.ne.obuff+osize-1)) goto 23174 continue ptr=obuff+osize-1 23176 if(.not.(ptr.ge.obufp)) goto 23178 obuf(ptr)=0 23177 ptr=ptr-1 goto 23176 23178 continue 23174 continue wcnt=osize/2 ostat=iwritw(wcnt,obuf(obuff),oblk,ochan) if(.not.(ostat.le.-1)) goto 23179 callferror(16hcloso: write err) 23179 continue callclosec(ochan) callifreec(ochan) return end subroutineclosio(fd) integerfd common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf callclosec(fd) callifreec(fd) inbufb=inbufb-2*insize return end blockdata common/cchar/extdig(10),intdig(10),extlet(26),intlet(26),extbig(26 *),intbig(26),extchr(33),intchr(33),extblk,intblk,intran(127) integerextdig integerintdig integerextlet integerintlet integerextbig integerintbig integerextchr integerintchr integerextblk integerintblk byteintran common/cdefio/bp,buf(300) integerbp integerbuf common/cfor/fordep,forstk(200) integerfordep integerforstk common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil, *vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil integersdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5) integersfor(4),srept(7),suntil(6) integervdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(2) integervfor(2),vrept(2),vuntil(2) common/cline/level,linect(5),infile(5),inbufp(5),inbufb,blk(5),ins *ize,inbuff(5),inbufe(5),instat(5) integerlevel integerlinect integerinfile integerinbufp integerinbufb integerblk integerinsize integerinbuff integerinbufe integerinstat common/clook/lastp,lastt,namptr(200),table(1500) integerlastp integerlastt integernamptr integertable common/coutln/outp,outbuf(81),obufp,obuff,obufe,osize,ochan,ostat, *oblk integeroutp integeroutbuf integer*2obufp integer*2obuff integer*2obufe integer*2osize integer*2ochan integer*2ostat integer*2oblk common/ciobuf/obuf(1024),inbuf(10240) byteobuf byteinbuf dataoutp/0/ datalinect(1)/1/ databp/0/ datafordep/0/ datalastp/0/ datalastt/0/ datasdo(1),sdo(2),sdo(3)/100,111,10002/ datavdo(1),vdo(2)/10266,10002/ datasif(1),sif(2),sif(3)/105,102,10002/ datavif(1),vif(2)/10261,10002/ dataselse(1),selse(2),selse(3),selse(4),selse(5)/101,108,115,101,1 *0002/ datavelse(1),velse(2)/10262,10002/ dataswhile(1),swhile(2),swhile(3),swhile(4),swhile(5),swhile(6)/11 *9,104,105,108,101,10002/ datavwhile(1),vwhile(2)/10263,10002/ datasbreak(1),sbreak(2),sbreak(3),sbreak(4),sbreak(5),sbreak(6)/98 *,114,101,97,107,10002/ datavbreak(1),vbreak(2)/10264,10002/ datasnext(1),snext(2),snext(3),snext(4),snext(5)/110,101,120,116,1 *0002/ datavnext(1),vnext(2)/10265,10002/ datasfor(1),sfor(2),sfor(3),sfor(4)/102,111,114,10002/ datavfor(1),vfor(2)/10268,10002/ datasrept(1),srept(2),srept(3),srept(4),srept(5),srept(6),srept(7) */114,101,112,101,97,116,10002/ datavrept(1),vrept(2)/10269,10002/ datasuntil(1),suntil(2),suntil(3),suntil(4),suntil(5),suntil(6)/11 *7,110,116,105,108,10002/ datavuntil(1),vuntil(2)/10270,10002/ dataextblk/1h /,intblk/32/ dataextdig(1)/1h0/,intdig(1)/48/ dataextdig(2)/1h1/,intdig(2)/49/ dataextdig(3)/1h2/,intdig(3)/50/ dataextdig(4)/1h3/,intdig(4)/51/ dataextdig(5)/1h4/,intdig(5)/52/ dataextdig(6)/1h5/,intdig(6)/53/ dataextdig(7)/1h6/,intdig(7)/54/ dataextdig(8)/1h7/,intdig(8)/55/ dataextdig(9)/1h8/,intdig(9)/56/ dataextdig(10)/1h9/,intdig(10)/57/ dataextlet(1)/1ha/,intlet(1)/97/ dataextlet(2)/1hb/,intlet(2)/98/ dataextlet(3)/1hc/,intlet(3)/99/ dataextlet(4)/1hd/,intlet(4)/100/ dataextlet(5)/1he/,intlet(5)/101/ dataextlet(6)/1hf/,intlet(6)/102/ dataextlet(7)/1hg/,intlet(7)/103/ dataextlet(8)/1hh/,intlet(8)/104/ dataextlet(9)/1hi/,intlet(9)/105/ dataextlet(10)/1hj/,intlet(10)/106/ dataextlet(11)/1hk/,intlet(11)/107/ dataextlet(12)/1hl/,intlet(12)/108/ dataextlet(13)/1hm/,intlet(13)/109/ dataextlet(14)/1hn/,intlet(14)/110/ dataextlet(15)/1ho/,intlet(15)/111/ dataextlet(16)/1hp/,intlet(16)/112/ dataextlet(17)/1hq/,intlet(17)/113/ dataextlet(18)/1hr/,intlet(18)/114/ dataextlet(19)/1hs/,intlet(19)/115/ dataextlet(20)/1ht/,intlet(20)/116/ dataextlet(21)/1hu/,intlet(21)/117/ dataextlet(22)/1hv/,intlet(22)/118/ dataextlet(23)/1hw/,intlet(23)/119/ dataextlet(24)/1hx/,intlet(24)/120/ dataextlet(25)/1hy/,intlet(25)/121/ dataextlet(26)/1hz/,intlet(26)/122/ dataextbig(1)/1hA/,intbig(1)/65/ dataextbig(2)/1hB/,intbig(2)/66/ dataextbig(3)/1hC/,intbig(3)/67/ dataextbig(4)/1hD/,intbig(4)/68/ dataextbig(5)/1hE/,intbig(5)/69/ dataextbig(6)/1hF/,intbig(6)/70/ dataextbig(7)/1hG/,intbig(7)/71/ dataextbig(8)/1hH/,intbig(8)/72/ dataextbig(9)/1hI/,intbig(9)/73/ dataextbig(10)/1hJ/,intbig(10)/74/ dataextbig(11)/1hK/,intbig(11)/75/ dataextbig(12)/1hL/,intbig(12)/76/ dataextbig(13)/1hM/,intbig(13)/77/ dataextbig(14)/1hN/,intbig(14)/78/ dataextbig(15)/1hO/,intbig(15)/79/ dataextbig(16)/1hP/,intbig(16)/80/ dataextbig(17)/1hQ/,intbig(17)/81/ dataextbig(18)/1hR/,intbig(18)/82/ dataextbig(19)/1hS/,intbig(19)/83/ dataextbig(20)/1hT/,intbig(20)/84/ dataextbig(21)/1hU/,intbig(21)/85/ dataextbig(22)/1hV/,intbig(22)/86/ dataextbig(23)/1hW/,intbig(23)/87/ dataextbig(24)/1hX/,intbig(24)/88/ dataextbig(25)/1hY/,intbig(25)/89/ dataextbig(26)/1hZ/,intbig(26)/90/ dataextchr(1)/1h!/,intchr(1)/33/ dataextchr(2)/1h"/,intchr(2)/34/ dataextchr(3)/1h#/,intchr(3)/35/ dataextchr(4)/1h$/,intchr(4)/36/ dataextchr(5)/1h%/,intchr(5)/37/ dataextchr(6)/1h&/,intchr(6)/38/ dataextchr(7)/1h'/,intchr(7)/39/ dataextchr(8)/1h(/,intchr(8)/40/ dataextchr(9)/1h)/,intchr(9)/41/ dataextchr(10)/1h*/,intchr(10)/42/ dataextchr(11)/1h+/,intchr(11)/43/ dataextchr(12)/1h,/,intchr(12)/44/ dataextchr(13)/1h-/,intchr(13)/45/ dataextchr(14)/1h./,intchr(14)/46/ dataextchr(15)/1h//,intchr(15)/47/ dataextchr(16)/1h:/,intchr(16)/58/ dataextchr(17)/1h;/,intchr(17)/59/ dataextchr(18)/1h/,intchr(20)/62/ dataextchr(21)/1h?/,intchr(21)/63/ dataextchr(22)/1h@/,intchr(22)/64/ dataextchr(23)/1h[/,intchr(23)/91/ dataextchr(24)/1h"/,intchr(24)/92/ dataextchr(25)/1h]/,intchr(25)/93/ dataextchr(26)/1h_/,intchr(26)/95/ dataextchr(27)/1h{/,intchr(27)/123/ dataextchr(28)/1h|/,intchr(28)/124/ dataextchr(29)/1h}/,intchr(29)/125/ dataextchr(32)/1h!/,intchr(32)/33/ dataextchr(33)/1h~/,intchr(33)/33/ dataextchr(31)/1h /,intchr(31)/9/ dataextchr(30)/1h/,intchr(30)/8/ dataintran(1)/1/ dataintran(2)/2/ dataintran(3)/3/ dataintran(4)/4/ dataintran(5)/5/ dataintran(6)/6/ dataintran(7)/7/ dataintran(8)/8/ dataintran(9)/9/ dataintran(10)/10/ dataintran(11)/11/ dataintran(12)/12/ dataintran(13)/13/ dataintran(14)/14/ dataintran(15)/15/ dataintran(16)/16/ dataintran(17)/17/ dataintran(18)/18/ dataintran(19)/19/ dataintran(20)/20/ dataintran(21)/21/ dataintran(22)/22/ dataintran(23)/23/ dataintran(24)/24/ dataintran(25)/25/ dataintran(26)/26/ dataintran(27)/27/ dataintran(28)/28/ dataintran(29)/29/ dataintran(30)/30/ dataintran(31)/31/ dataintran(32)/32/ dataintran(33)/33/ dataintran(34)/34/ dataintran(35)/35/ dataintran(36)/36/ dataintran(37)/37/ dataintran(38)/38/ dataintran(39)/39/ dataintran(40)/40/ dataintran(41)/41/ dataintran(42)/42/ dataintran(43)/43/ dataintran(44)/44/ dataintran(45)/45/ dataintran(46)/46/ dataintran(47)/47/ dataintran(48)/48/ dataintran(49)/49/ dataintran(50)/50/ dataintran(51)/51/ dataintran(52)/52/ dataintran(53)/53/ dataintran(54)/54/ dataintran(55)/55/ dataintran(56)/56/ dataintran(57)/57/ dataintran(58)/58/ dataintran(59)/59/ dataintran(60)/60/ dataintran(61)/61/ dataintran(62)/62/ dataintran(63)/63/ dataintran(64)/64/ dataintran(65)/65/ dataintran(66)/66/ dataintran(67)/67/ dataintran(68)/68/ dataintran(69)/69/ dataintran(70)/70/ dataintran(71)/71/ dataintran(72)/72/ dataintran(73)/73/ dataintran(74)/74/ dataintran(75)/75/ dataintran(76)/76/ dataintran(77)/77/ dataintran(78)/78/ dataintran(79)/79/ dataintran(80)/80/ dataintran(81)/81/ dataintran(82)/82/ dataintran(83)/83/ dataintran(84)/84/ dataintran(85)/85/ dataintran(86)/86/ dataintran(87)/87/ dataintran(88)/88/ dataintran(89)/89/ dataintran(90)/90/ dataintran(91)/91/ dataintran(92)/92/ dataintran(93)/93/ dataintran(94)/33/ dataintran(95)/95/ dataintran(96)/96/ dataintran(97)/97/ dataintran(98)/98/ dataintran(99)/99/ dataintran(100)/100/ dataintran(101)/101/ dataintran(102)/102/ dataintran(103)/103/ dataintran(104)/104/ dataintran(105)/105/ dataintran(106)/106/ dataintran(107)/107/ dataintran(108)/108/ dataintran(109)/109/ dataintran(110)/110/ dataintran(111)/111/ dataintran(112)/112/ dataintran(113)/113/ dataintran(114)/114/ dataintran(115)/115/ dataintran(116)/116/ dataintran(117)/117/ dataintran(118)/118/ dataintran(119)/119/ dataintran(120)/120/ dataintran(121)/121/ dataintran(122)/122/ dataintran(123)/123/ dataintran(124)/124/ dataintran(125)/125/ dataintran(126)/126/ dataintran(127)/127/ end