home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug049.ark / RATFOR.FOR < prev    next >
Encoding:
Text File  |  1984-04-29  |  39.8 KB  |  1,557 lines
  1.       programratfor
  2.       bytename(8),namer(11),namef(11)
  3.       datanamer(9),namer(10),namer(11)/1hR,1hA,1hT/
  4.       datanamef(9),namef(10),namef(11)/1hF,1hO,1hR/
  5. 9     format(51hAddison-Wesley Ratfor adapted for FORTRAN-80 August,59h1
  6.      &979 by Tim Prince, 1 EastLakeView Apt 17, Cincinnati 45237)
  7.       write(3,1,err=3)
  8. 1     format(1x,17hInput file name ?)
  9. 3     read(3,2,err=4)name
  10. 2     format(8a1)
  11. 4     do 23000i=1,8
  12.       namer(i)=name(i)
  13.       namef(i)=name(i)
  14. 23000 continue
  15. 23001 continue
  16.       callopen(7,namer,0)
  17.       callopen(6,namef,0)
  18.       callparse
  19.       endfile6
  20.       stop
  21.       end
  22.       blockdatainitl
  23.       integerbp
  24.       bytebuf
  25.       integer*1fordep
  26.       byteforstk
  27.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  28.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  29.      &2),vfor(2),vrept(2),vuntil(2)
  30.       integerlevel
  31.       integerlinect
  32.       integerinfile
  33.       integerlastp
  34.       integerlastt
  35.       integernamptr
  36.       bytetable
  37.       integeroutp
  38.       byteoutbuf
  39.       common/cdefio/bp,buf(300)
  40.       common/cfor/fordep,forstk(200)
  41.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  42.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  43.       common/cline/level,linect(5),infile(5)
  44.       common/clook/lastp,lastt,namptr(200),table(1500)
  45.       common/coutln/outp,outbuf(81)
  46.       dataoutp/0/
  47.       datalevel/1/,linect(1)/1/,infile(1)/7/
  48.       databp/0/
  49.       datafordep/0/
  50.       datalastp/0/,lastt/0/
  51.       datasdo/100,111,-2/,vdo/-66,-2/
  52.       datasif/105,102,-2/,vif/-61,-2/
  53.       dataselse/101,108,115,101,-2/
  54.       datavelse/-62,-2/
  55.       dataswhile/119,104,105,108,101,-2/
  56.       datavwhile/-63,-2/
  57.       datasbreak/98,114,101,97,107,-2/
  58.       datavbreak/-64,-2/
  59.       datasnext/110,101,120,116,-2/
  60.       datavnext/-65,-2/
  61.       datasfor/102,111,114,-2/,vfor/-68,-2/
  62.       datasrept/114,101,112,101,97,116,-2/
  63.       datavrept/-69,-2/
  64.       datasuntil/117,110,116,105,108,-2/
  65.       datavuntil/-70,-2/
  66.       end
  67.       logicalfunctionalldig(str)
  68.       bytetype,str(100)
  69.       alldig=.false.
  70.       if(.not.(str(1).eq.-2))goto 23002
  71.       return
  72. 23002 continue
  73.       continue
  74.       i=1
  75. 23004 if(.not.(str(i).ne.-2))goto 23006
  76.       if(.not.(type(str(i)).ne.2))goto 23007
  77.       return
  78. 23007 continue
  79. 23005 i=i+1
  80.       goto 23004
  81. 23006 continue
  82.       alldig=.true.
  83.       return
  84.       end
  85.       subroutinebalpar
  86.       bytegettok,t,token(200)
  87.       integer*1nlpar
  88.       if(.not.(gettok(token,200).ne.40))goto 23009
  89.       callsynerr(19hmissing left paren.)
  90.       return
  91. 23009 continue
  92.       calloutstr(token)
  93.       nlpar=1
  94.       continue
  95. 23011 continue
  96.       t=gettok(token,200)
  97.       if(.not.(t.eq.59.or.t.eq.123.or.t.eq.125.or.t.eq.-3))goto 23014
  98.       callpbstr(token)
  99.       goto 23013
  100. 23014 continue
  101.       if(.not.(t.eq.10))goto 23016
  102.       token(1)=-2
  103.       goto 23017
  104. 23016 continue
  105.       if(.not.(t.eq.40))goto 23018
  106.       nlpar=nlpar+1
  107.       goto 23019
  108. 23018 continue
  109.       if(.not.(t.eq.41))goto 23020
  110.       nlpar=nlpar-1
  111. 23020 continue
  112. 23019 continue
  113. 23017 continue
  114.       calloutstr(token)
  115. 23012 if(.not.(nlpar.le.0))goto 23011
  116. 23013 continue
  117.       if(.not.(nlpar.ne.0))goto 23022
  118.       callsynerr(33hmissing parenthesis in condition.)
  119. 23022 continue
  120.       return
  121.       end
  122.       subroutinebrknxt(sp,lextyp,labval,token)
  123.       integeri,labval(100),sp
  124.       bytelextyp(100),token
  125.       continue
  126.       i=sp
  127. 23024 if(.not.(i.gt.0))goto 23026
  128.       if(.not.(lextyp(i).eq.-63.or.lextyp(i).eq.-66.or.lextyp(i).eq.-68.
  129.      &or.lextyp(i).eq.-69))goto 23027
  130.       labout=labval(i)
  131.       if(.not.(token.eq.-64))goto 23029
  132.       labout=labout+1
  133. 23029 continue
  134.       calloutgo(labout)
  135.       return
  136. 23027 continue
  137. 23025 i=i-1
  138.       goto 23024
  139. 23026 continue
  140.       if(.not.(token.eq.-64))goto 23031
  141.       callsynerr(14hillegal break.)
  142.       goto 23032
  143. 23031 continue
  144.       callsynerr(13hillegal next.)
  145. 23032 continue
  146.       return
  147.       end
  148.       subroutineclosei(fd)
  149.       integerfd
  150.       endfilefd
  151.       return
  152.       end
  153.       bytefunctiondeftok(token,toksiz,fd)
  154.       integerfd,toksiz
  155.       bytegtok,defn(200),t,token(toksiz)
  156.       logicallookup
  157.       continue
  158.       t=gtok(token,toksiz,fd)
  159. 23033 if(.not.(t.ne.-3))goto 23035
  160.       if(.not.(t.ne.-100))goto 23036
  161.       goto 23035
  162. 23036 continue
  163.       if(.not.(.not.lookup(token,defn)))goto 23038
  164.       goto 23035
  165. 23038 continue
  166.       if(.not.(defn(1).eq.-10))goto 23040
  167.       callgetdef(token,toksiz,defn,200,fd)
  168.       callinstal(token,defn)
  169.       goto 23041
  170. 23040 continue
  171.       callpbstr(defn)
  172. 23041 continue
  173. 23034 t=gtok(token,toksiz,fd)
  174.       goto 23033
  175. 23035 continue
  176.       deftok=t
  177.       if(.not.(deftok.eq.-100))goto 23042
  178.       callfold(token)
  179. 23042 continue
  180.       return
  181.       end
  182.       subroutinefold(token)
  183.       bytetoken(100)
  184.       integer*1lwrmup
  185.       lwrmup=97-65
  186.       continue
  187.       i=1
  188. 23044 if(.not.(token(i).ne.-2))goto 23046
  189.       if(.not.(token(i).ge.65.and.token(i).le.90))goto 23047
  190.       token(i)=token(i)+lwrmup
  191. 23047 continue
  192. 23045 i=i+1
  193.       goto 23044
  194. 23046 continue
  195.       return
  196.       end
  197.       subroutinedocode(lab)
  198.       bytedostr(4)
  199.       datadostr/100,111,32,-2/
  200.       callouttab
  201.       calloutstr(dostr)
  202.       lab=labgen(2)
  203.       calloutnum(lab)
  204.       calleatup
  205.       calloutdon
  206.       return
  207.       end
  208.       subroutinedostat(lab)
  209.       calloutcon(lab)
  210.       calloutcon(lab+1)
  211.       return
  212.       end
  213.       subroutineeatup
  214.       bytegettok,ptoken(200),t,token(200)
  215.       integer*1nlpar
  216.       nlpar=0
  217.       continue
  218. 23049 continue
  219.       t=gettok(token,200)
  220.       if(.not.(t.eq.59.or.t.eq.10))goto 23052
  221.       goto 23051
  222. 23052 continue
  223.       if(.not.(t.eq.125))goto 23054
  224.       callpbstr(token)
  225.       goto 23051
  226. 23054 continue
  227.       if(.not.(t.eq.123.or.t.eq.-3))goto 23056
  228.       callsynerr(24hunexpected brace or eof.)
  229.       callpbstr(token)
  230.       goto 23051
  231. 23056 continue
  232.       if(.not.(t.eq.44.or.t.eq.95))goto 23058
  233.       if(.not.(gettok(ptoken,200).ne.10))goto 23060
  234.       callpbstr(ptoken)
  235. 23060 continue
  236.       if(.not.(t.eq.95))goto 23062
  237.       token(1)=-2
  238. 23062 continue
  239.       goto 23059
  240. 23058 continue
  241.       if(.not.(t.eq.40))goto 23064
  242.       nlpar=nlpar+1
  243.       goto 23065
  244. 23064 continue
  245.       if(.not.(t.eq.41))goto 23066
  246.       nlpar=nlpar-1
  247. 23066 continue
  248. 23065 continue
  249. 23059 continue
  250.       calloutstr(token)
  251. 23050 if(.not.(nlpar.lt.0))goto 23049
  252. 23051 continue
  253.       if(.not.(nlpar.ne.0))goto 23068
  254.       callsynerr(23hunbalanced parentheses.)
  255. 23068 continue
  256.       return
  257.       end
  258.       subroutineelseif(lab)
  259.       calloutgo(lab+1)
  260.       calloutcon(lab)
  261.       return
  262.       end
  263.       logicalfunctionequal(str1,str2)
  264.       bytestr1(100),str2(100)
  265.       continue
  266.       i=1
  267. 23070 if(.not.(str1(i).eq.str2(i)))goto 23072
  268.       if(.not.(str1(i).eq.-2))goto 23073
  269.       equal=.true.
  270.       return
  271. 23073 continue
  272. 23071 i=i+1
  273.       goto 23070
  274. 23072 continue
  275.       equal=.false.
  276.       return
  277.       end
  278.       subroutineerror(buf)
  279.       bytebuf(100)
  280.       callremark(buf)
  281.       endfile6
  282.       stop
  283.       end
  284.       subroutineforcod(lab)
  285.       bytegettok,t,token(200),ifnot(9)
  286.       integer*1i,nlpar
  287.       integerbp
  288.       bytebuf
  289.       integer*1fordep
  290.       byteforstk
  291.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  292.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  293.      &2),vfor(2),vrept(2),vuntil(2)
  294.       integerlevel
  295.       integerlinect
  296.       integerinfile
  297.       integerlastp
  298.       integerlastt
  299.       integernamptr
  300.       bytetable
  301.       integeroutp
  302.       byteoutbuf
  303.       common/cdefio/bp,buf(300)
  304.       common/cfor/fordep,forstk(200)
  305.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  306.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  307.       common/cline/level,linect(5),infile(5)
  308.       common/clook/lastp,lastt,namptr(200),table(1500)
  309.       common/coutln/outp,outbuf(81)
  310.       dataifnot/105,102,40,46,110,111,116,46,-2/
  311.       lab=labgen(3)
  312.       calloutcon(0)
  313.       if(.not.(gettok(token,200).ne.40))goto 23075
  314.       callsynerr(19hmissing left paren.)
  315.       return
  316. 23075 continue
  317.       if(.not.(gettok(token,200).ne.59))goto 23077
  318.       callpbstr(token)
  319.       callouttab
  320.       calleatup
  321.       calloutdon
  322. 23077 continue
  323.       if(.not.(gettok(token,200).eq.59))goto 23079
  324.       calloutcon(lab)
  325.       goto 23080
  326. 23079 continue
  327.       callpbstr(token)
  328.       calloutnum(lab)
  329.       callouttab
  330.       calloutstr(ifnot)
  331.       calloutch(40)
  332.       nlpar=0
  333.       continue
  334. 23081 if(.not.(nlpar.ge.0))goto 23082
  335.       t=gettok(token,200)
  336.       if(.not.(t.eq.59))goto 23083
  337.       goto 23082
  338. 23083 continue
  339.       if(.not.(t.eq.40))goto 23085
  340.       nlpar=nlpar+1
  341.       goto 23086
  342. 23085 continue
  343.       if(.not.(t.eq.41))goto 23087
  344.       nlpar=nlpar-1
  345. 23087 continue
  346. 23086 continue
  347.       if(.not.(t.ne.10.and.t.ne.95))goto 23089
  348.       calloutstr(token)
  349. 23089 continue
  350.       goto 23081
  351. 23082 continue
  352.       calloutch(41)
  353.       calloutch(41)
  354.       calloutgo(lab+2)
  355.       if(.not.(nlpar.lt.0))goto 23091
  356.       callsynerr(19hinvalid for clause.)
  357. 23091 continue
  358. 23080 continue
  359.       fordep=fordep+1
  360.       j=1
  361.       continue
  362.       i=1
  363. 23093 if(.not.(i.lt.fordep))goto 23095
  364.       j=j+length(forstk(j))+1
  365. 23094 i=i+1
  366.       goto 23093
  367. 23095 continue
  368.       forstk(j)=-2
  369.       nlpar=0
  370.       continue
  371. 23096 if(.not.(nlpar.ge.0))goto 23097
  372.       t=gettok(token,200)
  373.       if(.not.(t.eq.40))goto 23098
  374.       nlpar=nlpar+1
  375.       goto 23099
  376. 23098 continue
  377.       if(.not.(t.eq.41))goto 23100
  378.       nlpar=nlpar-1
  379. 23100 continue
  380. 23099 continue
  381.       if(.not.(nlpar.ge.0.and.t.ne.10.and.t.ne.95))goto 23102
  382.       callscopy(token,1,forstk,j)
  383.       j=j+length(token)
  384. 23102 continue
  385.       goto 23096
  386. 23097 continue
  387.       lab=lab+1
  388.       return
  389.       end
  390.       subroutinefors(lab)
  391.       integer*1i
  392.       integerbp
  393.       bytebuf
  394.       integer*1fordep
  395.       byteforstk
  396.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  397.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  398.      &2),vfor(2),vrept(2),vuntil(2)
  399.       integerlevel
  400.       integerlinect
  401.       integerinfile
  402.       integerlastp
  403.       integerlastt
  404.       integernamptr
  405.       bytetable
  406.       integeroutp
  407.       byteoutbuf
  408.       common/cdefio/bp,buf(300)
  409.       common/cfor/fordep,forstk(200)
  410.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  411.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  412.       common/cline/level,linect(5),infile(5)
  413.       common/clook/lastp,lastt,namptr(200),table(1500)
  414.       common/coutln/outp,outbuf(81)
  415.       calloutnum(lab)
  416.       j=1
  417.       continue
  418.       i=1
  419. 23104 if(.not.(i.lt.fordep))goto 23106
  420.       j=j+length(forstk(j))+1
  421. 23105 i=i+1
  422.       goto 23104
  423. 23106 continue
  424.       if(.not.(length(forstk(j)).gt.0))goto 23107
  425.       callouttab
  426.       calloutstr(forstk(j))
  427.       calloutdon
  428. 23107 continue
  429.       calloutgo(lab-1)
  430.       calloutcon(lab+1)
  431.       fordep=fordep-1
  432.       return
  433.       end
  434.       bytefunctiongetch(c,f)
  435.       bytebuf(81),c
  436.       integerf
  437.       datalastc/81/,buf(81)/10/
  438.       if(.not.(buf(lastc).eq.10.or.lastc.ge.81))goto 23109
  439.       read(f,1,err=5,end=10)(buf(i),i=1,80)
  440. 1     format(80a1)
  441.       continue
  442.       i=80
  443. 23111 if(.not.(i.gt.0))goto 23113
  444.       if(.not.(buf(i).ne.32))goto 23114
  445.       goto 23113
  446. 23114 continue
  447. 23112 i=i-1
  448.       goto 23111
  449. 23113 continue
  450.       buf(i+1)=10
  451.       goto7
  452. 5     buf(1)=63
  453.       buf(2)=10
  454. 7     if(.not.(buf(1).eq.10))goto 23116
  455.       lastc=1
  456.       goto 23117
  457. 23116 continue
  458.       lastc=0
  459. 23117 continue
  460. 23109 continue
  461.       lastc=lastc+1
  462.       c=buf(lastc)
  463.       getch=c
  464.       return
  465. 10    c=-3
  466.       getch=-3
  467.       return
  468.       end
  469.       subroutinegetdef(token,toksiz,defn,defsiz,fd)
  470.       integerdefsiz,fd,toksiz
  471.       bytegtok,ngetch,c,defn(defsiz),token(toksiz)
  472.       integer*1nlpar
  473.       if(.not.(ngetch(c,fd).ne.40))goto 23118
  474.       callremark(19hmissing left paren.)
  475. 23118 continue
  476.       if(.not.(gtok(token,toksiz,fd).ne.-100))goto 23120
  477.       callremark(22hnon-alphanumeric name.)
  478.       goto 23121
  479. 23120 continue
  480.       if(.not.(ngetch(c,fd).ne.44))goto 23122
  481.       callremark(24hmissing comma in define.)
  482. 23122 continue
  483. 23121 continue
  484.       nlpar=0
  485.       continue
  486.       i=1
  487. 23124 if(.not.(nlpar.ge.0))goto 23126
  488.       if(.not.(i.gt.defsiz))goto 23127
  489.       callerror(20hdefinition too long.)
  490.       goto 23128
  491. 23127 continue
  492.       if(.not.(ngetch(defn(i),fd).eq.-3))goto 23129
  493.       callerror(20hmissing right paren.)
  494.       goto 23130
  495. 23129 continue
  496.       if(.not.(defn(i).eq.40))goto 23131
  497.       nlpar=nlpar+1
  498.       goto 23132
  499. 23131 continue
  500.       if(.not.(defn(i).eq.41))goto 23133
  501.       nlpar=nlpar-1
  502. 23133 continue
  503. 23132 continue
  504. 23130 continue
  505. 23128 continue
  506. 23125 i=i+1
  507.       goto 23124
  508. 23126 continue
  509.       defn(i-1)=-2
  510.       return
  511.       end
  512.       bytefunctiongettok(token,toksiz)
  513.       logicalequal
  514.       integeropeni,toksiz
  515.       bytejunk
  516.       bytedeftok,name(30),token(toksiz),incl(8)
  517.       integerbp
  518.       bytebuf
  519.       integer*1fordep
  520.       byteforstk
  521.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  522.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  523.      &2),vfor(2),vrept(2),vuntil(2)
  524.       integerlevel
  525.       integerlinect
  526.       integerinfile
  527.       integerlastp
  528.       integerlastt
  529.       integernamptr
  530.       bytetable
  531.       integeroutp
  532.       byteoutbuf
  533.       common/cdefio/bp,buf(300)
  534.       common/cfor/fordep,forstk(200)
  535.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  536.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  537.       common/cline/level,linect(5),infile(5)
  538.       common/clook/lastp,lastt,namptr(200),table(1500)
  539.       common/coutln/outp,outbuf(81)
  540.       dataincl/105,110,99,108,117,100,101,-2/
  541.       continue
  542. 23135 if(.not.(level.gt.0))goto 23137
  543.       continue
  544.       gettok=deftok(token,toksiz,infile(level))
  545. 23138 if(.not.(gettok.ne.-3))goto 23140
  546.       if(.not.(.not.equal(token,incl)))goto 23141
  547.       return
  548. 23141 continue
  549.       junk=deftok(name,30,infile(level))
  550.       if(.not.(level.ge.5))goto 23143
  551.       callsynerr(27hincludes nested too deeply.)
  552.       goto 23144
  553. 23143 continue
  554.       infile(level+1)=openi(name,level+1)
  555.       linect(level+1)=1
  556.       level=level+1
  557. 23144 continue
  558. 23139 gettok=deftok(token,toksiz,infile(level))
  559.       goto 23138
  560. 23140 continue
  561.       if(.not.(level.gt.1))goto 23145
  562.       callclosei(infile(level))
  563. 23145 continue
  564. 23136 level=level-1
  565.       goto 23135
  566. 23137 continue
  567.       gettok=-3
  568.       return
  569.       end
  570.       bytefunctiongtok(lexstr,toksiz,fd)
  571.       integertoksiz,fd
  572.       bytengetch,type,c,lexstr(toksiz)
  573.       integerbp
  574.       bytebuf
  575.       integer*1fordep
  576.       byteforstk
  577.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  578.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  579.      &2),vfor(2),vrept(2),vuntil(2)
  580.       integerlevel
  581.       integerlinect
  582.       integerinfile
  583.       integerlastp
  584.       integerlastt
  585.       integernamptr
  586.       bytetable
  587.       integeroutp
  588.       byteoutbuf
  589.       common/cdefio/bp,buf(300)
  590.       common/cfor/fordep,forstk(200)
  591.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  592.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  593.       common/cline/level,linect(5),infile(5)
  594.       common/clook/lastp,lastt,namptr(200),table(1500)
  595.       common/coutln/outp,outbuf(81)
  596.       continue
  597. 23147 if(.not.(ngetch(c,fd).ne.-3))goto 23148
  598.       if(.not.(c.ne.32.and.c.ne.9))goto 23149
  599.       goto 23148
  600. 23149 continue
  601.       goto 23147
  602. 23148 continue
  603.       callputbak(c)
  604.       continue
  605.       i=1
  606. 23151 if(.not.(i.lt.toksiz-1))goto 23153
  607.       gtok=type(ngetch(lexstr(i),fd))
  608.       if(.not.(gtok.ne.1.and.gtok.ne.2))goto 23154
  609.       goto 23153
  610. 23154 continue
  611. 23152 i=i+1
  612.       goto 23151
  613. 23153 continue
  614.       if(.not.(i.ge.toksiz-1))goto 23156
  615.       callsynerr(15htoken too long.)
  616. 23156 continue
  617.       if(.not.(i.gt.1))goto 23158
  618.       callputbak(lexstr(i))
  619.       lexstr(i)=-2
  620.       gtok=-100
  621.       goto 23159
  622. 23158 continue
  623.       if(.not.(lexstr(1).eq.36))goto 23160
  624.       if(.not.(ngetch(lexstr(2),fd).eq.40))goto 23162
  625.       lexstr(1)=123
  626.       gtok=123
  627.       goto 23163
  628. 23162 continue
  629.       if(.not.(lexstr(2).eq.41))goto 23164
  630.       lexstr(1)=125
  631.       gtok=125
  632.       goto 23165
  633. 23164 continue
  634.       callputbak(lexstr(2))
  635. 23165 continue
  636. 23163 continue
  637.       goto 23161
  638. 23160 continue
  639.       if(.not.(lexstr(1).eq.39.or.lexstr(1).eq.34))goto 23166
  640.       continue
  641.       i=2
  642. 23168 if(.not.(ngetch(lexstr(i),fd).ne.lexstr(1)))goto 23170
  643.       if(.not.(lexstr(i).eq.10.or.i.ge.toksiz-1))goto 23171
  644.       callsynerr(14hmissing quote.)
  645.       lexstr(i)=lexstr(1)
  646.       callputbak(10)
  647.       goto 23170
  648. 23171 continue
  649. 23169 i=i+1
  650.       goto 23168
  651. 23170 continue
  652.       goto 23167
  653. 23166 continue
  654.       if(.not.(lexstr(1).eq.35))goto 23173
  655.       continue
  656. 23175 if(.not.(ngetch(lexstr(1),fd).ne.10))goto 23176
  657.       goto 23175
  658. 23176 continue
  659.       gtok=10
  660.       goto 23174
  661. 23173 continue
  662.       if(.not.(lexstr(1).eq.126.or.lexstr(1).eq.94))goto 23177
  663.       lexstr(1)=33
  664. 23177 continue
  665.       if(.not.(lexstr(1).eq.62.or.lexstr(1).eq.60.or.lexstr(1).eq.33.or.
  666.      &lexstr(1).eq.61.or.lexstr(1).eq.38.or.lexstr(1).eq.124))goto 23179
  667.       callrelate(lexstr,i,fd)
  668. 23179 continue
  669. 23174 continue
  670. 23167 continue
  671. 23161 continue
  672. 23159 continue
  673.       lexstr(i+1)=-2
  674.       if(.not.(lexstr(1).eq.10))goto 23181
  675.       linect(level)=linect(level)+1
  676. 23181 continue
  677.       return
  678.       end
  679.       subroutineifcode(lab)
  680.       lab=labgen(2)
  681.       callifgo(lab)
  682.       return
  683.       end
  684.       subroutineifgo(lab)
  685.       byteifnot(9)
  686.       dataifnot/105,102,40,46,110,111,116,46,-2/
  687.       callouttab
  688.       calloutstr(ifnot)
  689.       callbalpar
  690.       calloutch(41)
  691.       calloutgo(lab)
  692.       return
  693.       end
  694.       subroutineinitkw
  695.       bytedefnam(7),deftyp(2)
  696.       datadefnam/100,101,102,105,110,101,-2/
  697.       datadeftyp/-10,-2/
  698.       callinstal(defnam,deftyp)
  699.       return
  700.       end
  701.       subroutineinstal(name,defn)
  702.       bytedefn(200),name(200)
  703.       integerdlen
  704.       integerbp
  705.       bytebuf
  706.       integer*1fordep
  707.       byteforstk
  708.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  709.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  710.      &2),vfor(2),vrept(2),vuntil(2)
  711.       integerlevel
  712.       integerlinect
  713.       integerinfile
  714.       integerlastp
  715.       integerlastt
  716.       integernamptr
  717.       bytetable
  718.       integeroutp
  719.       byteoutbuf
  720.       common/cdefio/bp,buf(300)
  721.       common/cfor/fordep,forstk(200)
  722.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  723.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  724.       common/cline/level,linect(5),infile(5)
  725.       common/clook/lastp,lastt,namptr(200),table(1500)
  726.       common/coutln/outp,outbuf(81)
  727.       nlen=length(name)+1
  728.       dlen=length(defn)+1
  729.       if(.not.(lastt+nlen+dlen.gt.1500.or.lastp.ge.200))goto 23183
  730.       callputlin(name,3)
  731.       callremark(23h: too many definitions.)
  732. 23183 continue
  733.       lastp=lastp+1
  734.       namptr(lastp)=lastt+1
  735.       callscopy(name,1,table,lastt+1)
  736.       callscopy(defn,1,table,lastt+nlen+1)
  737.       lastt=lastt+nlen+dlen
  738.       return
  739.       end
  740.       functionitoc(int,str,size)
  741.       integersize
  742.       bytek,str(size)
  743.       intval=iabs(int)
  744.       str(1)=-2
  745.       i=1
  746.       continue
  747. 23185 continue
  748.       i=i+1
  749.       str(i)=mod(intval,10)+48
  750.       intval=intval/10
  751. 23186 if(.not.(intval.eq.0.or.i.ge.size))goto 23185
  752. 23187 continue
  753.       if(.not.(int.lt.0.and.i.lt.size))goto 23188
  754.       i=i+1
  755.       str(i)=45
  756. 23188 continue
  757.       itoc=i-1
  758.       continue
  759.       j=1
  760. 23190 if(.not.(j.lt.i))goto 23192
  761.       k=str(i)
  762.       str(i)=str(j)
  763.       str(j)=k
  764.       i=i-1
  765. 23191 j=j+1
  766.       goto 23190
  767. 23192 continue
  768.       return
  769.       end
  770.       subroutinelabelc(lexstr)
  771.       bytelexstr(100)
  772.       if(.not.(length(lexstr).eq.5))goto 23193
  773.       if(.not.(lexstr(1).eq.50.and.lexstr(2).eq.51))goto 23195
  774.       callsynerr(34hwarning:  possible label conflict.)
  775. 23195 continue
  776. 23193 continue
  777.       calloutstr(lexstr)
  778.       callouttab
  779.       return
  780.       end
  781.       functionlabgen(n)
  782.       datalabel/23000/
  783.       labgen=label
  784.       label=label+n
  785.       return
  786.       end
  787.       functionlength(str)
  788.       bytestr(100)
  789.       continue
  790.       length=0
  791. 23197 if(.not.(str(length+1).ne.-2))goto 23199
  792. 23198 length=length+1
  793.       goto 23197
  794. 23199 continue
  795.       return
  796.       end
  797.       bytefunctionlex(lexstr)
  798.       bytegettok,lexstr(200)
  799.       logicalalldig,equal
  800.       integerbp
  801.       bytebuf
  802.       integer*1fordep
  803.       byteforstk
  804.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  805.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  806.      &2),vfor(2),vrept(2),vuntil(2)
  807.       integerlevel
  808.       integerlinect
  809.       integerinfile
  810.       integerlastp
  811.       integerlastt
  812.       integernamptr
  813.       bytetable
  814.       integeroutp
  815.       byteoutbuf
  816.       common/cdefio/bp,buf(300)
  817.       common/cfor/fordep,forstk(200)
  818.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  819.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  820.       common/cline/level,linect(5),infile(5)
  821.       common/clook/lastp,lastt,namptr(200),table(1500)
  822.       common/coutln/outp,outbuf(81)
  823.       continue
  824. 23200 if(.not.(gettok(lexstr,200).eq.10))goto 23201
  825.       goto 23200
  826. 23201 continue
  827.       lex=lexstr(1)
  828.       if(.not.(lex.eq.-3.or.lex.eq.59.or.lex.eq.123.or.lex.eq.125))goto 
  829.      &23202
  830.       return
  831. 23202 continue
  832.       if(.not.(alldig(lexstr)))goto 23204
  833.       lex=-60
  834.       goto 23205
  835. 23204 continue
  836.       if(.not.(equal(lexstr,sif)))goto 23206
  837.       lex=vif(1)
  838.       goto 23207
  839. 23206 continue
  840.       if(.not.(equal(lexstr,selse)))goto 23208
  841.       lex=velse(1)
  842.       goto 23209
  843. 23208 continue
  844.       if(.not.(equal(lexstr,swhile)))goto 23210
  845.       lex=vwhile(1)
  846.       goto 23211
  847. 23210 continue
  848.       if(.not.(equal(lexstr,sdo)))goto 23212
  849.       lex=vdo(1)
  850.       goto 23213
  851. 23212 continue
  852.       if(.not.(equal(lexstr,sbreak)))goto 23214
  853.       lex=vbreak(1)
  854.       goto 23215
  855. 23214 continue
  856.       if(.not.(equal(lexstr,snext)))goto 23216
  857.       lex=vnext(1)
  858.       goto 23217
  859. 23216 continue
  860.       if(.not.(equal(lexstr,sfor)))goto 23218
  861.       lex=vfor(1)
  862.       goto 23219
  863. 23218 continue
  864.       if(.not.(equal(lexstr,srept)))goto 23220
  865.       lex=vrept(1)
  866.       goto 23221
  867. 23220 continue
  868.       if(.not.(equal(lexstr,suntil)))goto 23222
  869.       lex=vuntil(1)
  870.       goto 23223
  871. 23222 continue
  872.       lex=-67
  873. 23223 continue
  874. 23221 continue
  875. 23219 continue
  876. 23217 continue
  877. 23215 continue
  878. 23213 continue
  879. 23211 continue
  880. 23209 continue
  881. 23207 continue
  882. 23205 continue
  883.       return
  884.       end
  885.       logicalfunctionlookup(name,defn)
  886.       bytedefn(200),name(200)
  887.       integerbp
  888.       bytebuf
  889.       integer*1fordep
  890.       byteforstk
  891.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  892.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  893.      &2),vfor(2),vrept(2),vuntil(2)
  894.       integerlevel
  895.       integerlinect
  896.       integerinfile
  897.       integerlastp
  898.       integerlastt
  899.       integernamptr
  900.       bytetable
  901.       integeroutp
  902.       byteoutbuf
  903.       common/cdefio/bp,buf(300)
  904.       common/cfor/fordep,forstk(200)
  905.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  906.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  907.       common/cline/level,linect(5),infile(5)
  908.       common/clook/lastp,lastt,namptr(200),table(1500)
  909.       common/coutln/outp,outbuf(81)
  910.       continue
  911.       i=lastp
  912. 23224 if(.not.(i.gt.0))goto 23226
  913.       j=namptr(i)
  914.       continue
  915.       k=1
  916. 23227 if(.not.(name(k).eq.table(j).and.name(k).ne.-2))goto 23229
  917.       j=j+1
  918. 23228 k=k+1
  919.       goto 23227
  920. 23229 continue
  921.       if(.not.(name(k).eq.table(j)))goto 23230
  922.       callscopy(table,j+1,defn,1)
  923.       lookup=.true.
  924.       return
  925. 23230 continue
  926. 23225 i=i-1
  927.       goto 23224
  928. 23226 continue
  929.       lookup=.false.
  930.       return
  931.       end
  932.       bytefunctionngetch(c,fd)
  933.       bytegetch,c
  934.       integerfd
  935.       integerbp
  936.       bytebuf
  937.       integer*1fordep
  938.       byteforstk
  939.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  940.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  941.      &2),vfor(2),vrept(2),vuntil(2)
  942.       integerlevel
  943.       integerlinect
  944.       integerinfile
  945.       integerlastp
  946.       integerlastt
  947.       integernamptr
  948.       bytetable
  949.       integeroutp
  950.       byteoutbuf
  951.       common/cdefio/bp,buf(300)
  952.       common/cfor/fordep,forstk(200)
  953.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  954.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  955.       common/cline/level,linect(5),infile(5)
  956.       common/clook/lastp,lastt,namptr(200),table(1500)
  957.       common/coutln/outp,outbuf(81)
  958.       if(.not.(bp.gt.0))goto 23232
  959.       c=buf(bp)
  960.       goto 23233
  961. 23232 continue
  962.       bp=1
  963.       buf(1)=getch(c,fd)
  964. 23233 continue
  965.       bp=bp-1
  966.       ngetch=c
  967.       return
  968.       end
  969.       integerfunctionopeni(name,level)
  970.       bytename(30),namer(11)
  971.       datanamer(9),namer(10),namer(11)/1hR,1hA,1hT/
  972.       openi=level+6
  973.       continue
  974.       i=1
  975. 23234 if(.not.(i.le.8.and.name(i).ne.-2))goto 23236
  976.       if(.not.(name(i).gt.95))goto 23237
  977.       name(i)=name(i)-32
  978. 23237 continue
  979.       namer(i)=name(i)
  980. 23235 i=i+1
  981.       goto 23234
  982. 23236 continue
  983.       if(.not.(name(i).ne.-2))goto 23239
  984.       i=i+1
  985. 23239 continue
  986.       continue
  987. 23241 if(.not.(i.le.8))goto 23242
  988.       namer(i)=32
  989.       i=i+1
  990.       goto 23241
  991. 23242 continue
  992.       callopen(openi,namer,0)
  993.       return
  994.       end
  995.       subroutineotherc(lexstr)
  996.       bytelexstr(100)
  997.       callouttab
  998.       calloutstr(lexstr)
  999.       calleatup
  1000.       calloutdon
  1001.       return
  1002.       end
  1003.       subroutineoutch(c)
  1004.       bytec
  1005.       integerbp
  1006.       bytebuf
  1007.       integer*1fordep
  1008.       byteforstk
  1009.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  1010.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  1011.      &2),vfor(2),vrept(2),vuntil(2)
  1012.       integerlevel
  1013.       integerlinect
  1014.       integerinfile
  1015.       integerlastp
  1016.       integerlastt
  1017.       integernamptr
  1018.       bytetable
  1019.       integeroutp
  1020.       byteoutbuf
  1021.       common/cdefio/bp,buf(300)
  1022.       common/cfor/fordep,forstk(200)
  1023.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  1024.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  1025.       common/cline/level,linect(5),infile(5)
  1026.       common/clook/lastp,lastt,namptr(200),table(1500)
  1027.       common/coutln/outp,outbuf(81)
  1028.       if(.not.(outp.ge.72))goto 23243
  1029.       calloutdon
  1030.       do 23245i=1,5
  1031.       outbuf(i)=32
  1032. 23245 continue
  1033. 23246 continue
  1034.       outbuf(6)=38
  1035.       outp=6
  1036. 23243 continue
  1037.       outp=outp+1
  1038.       outbuf(outp)=c
  1039.       return
  1040.       end
  1041.       subroutineoutcon(n)
  1042.       bytecontin(9)
  1043.       datacontin/99,111,110,116,105,110,117,101,-2/
  1044.       if(.not.(n.gt.0))goto 23247
  1045.       calloutnum(n)
  1046. 23247 continue
  1047.       callouttab
  1048.       calloutstr(contin)
  1049.       calloutdon
  1050.       return
  1051.       end
  1052.       subroutineoutdon
  1053.       integerbp
  1054.       bytebuf
  1055.       integer*1fordep
  1056.       byteforstk
  1057.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  1058.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  1059.      &2),vfor(2),vrept(2),vuntil(2)
  1060.       integerlevel
  1061.       integerlinect
  1062.       integerinfile
  1063.       integerlastp
  1064.       integerlastt
  1065.       integernamptr
  1066.       bytetable
  1067.       integeroutp
  1068.       byteoutbuf
  1069.       common/cdefio/bp,buf(300)
  1070.       common/cfor/fordep,forstk(200)
  1071.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  1072.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  1073.       common/cline/level,linect(5),infile(5)
  1074.       common/clook/lastp,lastt,namptr(200),table(1500)
  1075.       common/coutln/outp,outbuf(81)
  1076.       outbuf(outp+1)=10
  1077.       outbuf(outp+2)=-2
  1078.       callputlin(outbuf,6)
  1079.       outp=0
  1080.       return
  1081.       end
  1082.       subroutineoutgo(n)
  1083.       bytegoto(6)
  1084.       datagoto/103,111,116,111,32,-2/
  1085.       callouttab
  1086.       calloutstr(goto)
  1087.       calloutnum(n)
  1088.       calloutdon
  1089.       return
  1090.       end
  1091.       subroutineoutnum(n)
  1092.       bytechars(10)
  1093.       len=itoc(n,chars,10)
  1094.       do 23249i=1,len
  1095.       calloutch(chars(i))
  1096. 23249 continue
  1097. 23250 continue
  1098.       return
  1099.       end
  1100.       subroutineoutstr(str)
  1101.       bytec,str(100)
  1102.       continue
  1103.       i=1
  1104. 23251 if(.not.(str(i).ne.-2))goto 23253
  1105.       c=str(i)
  1106.       if(.not.(c.ne.39.and.c.ne.34))goto 23254
  1107.       calloutch(c)
  1108.       goto 23255
  1109. 23254 continue
  1110.       i=i+1
  1111.       continue
  1112.       j=i
  1113. 23256 if(.not.(str(j).ne.c))goto 23258
  1114. 23257 j=j+1
  1115.       goto 23256
  1116. 23258 continue
  1117.       calloutnum(j-i)
  1118.       calloutch(104)
  1119.       continue
  1120. 23259 if(.not.(i.lt.j))goto 23261
  1121.       calloutch(str(i))
  1122. 23260 i=i+1
  1123.       goto 23259
  1124. 23261 continue
  1125. 23255 continue
  1126. 23252 i=i+1
  1127.       goto 23251
  1128. 23253 continue
  1129.       return
  1130.       end
  1131.       subroutineouttab
  1132.       integerbp
  1133.       bytebuf
  1134.       integer*1fordep
  1135.       byteforstk
  1136.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  1137.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  1138.      &2),vfor(2),vrept(2),vuntil(2)
  1139.       integerlevel
  1140.       integerlinect
  1141.       integerinfile
  1142.       integerlastp
  1143.       integerlastt
  1144.       integernamptr
  1145.       bytetable
  1146.       integeroutp
  1147.       byteoutbuf
  1148.       common/cdefio/bp,buf(300)
  1149.       common/cfor/fordep,forstk(200)
  1150.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  1151.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  1152.       common/cline/level,linect(5),infile(5)
  1153.       common/clook/lastp,lastt,namptr(200),table(1500)
  1154.       common/coutln/outp,outbuf(81)
  1155.       continue
  1156. 23262 if(.not.(outp.lt.6))goto 23263
  1157.       calloutch(32)
  1158.       goto 23262
  1159. 23263 continue
  1160.       return
  1161.       end
  1162.       subroutineparse
  1163.       bytelexstr(200),lex,lextyp(100),token
  1164.       integerlabval(100),sp
  1165.       callinitkw
  1166.       sp=1
  1167.       lextyp(1)=-3
  1168.       continue
  1169.       token=lex(lexstr)
  1170. 23264 if(.not.(token.ne.-3))goto 23266
  1171.       if(.not.(token.eq.-61))goto 23267
  1172.       callifcode(lab)
  1173.       goto 23268
  1174. 23267 continue
  1175.       if(.not.(token.eq.-66))goto 23269
  1176.       calldocode(lab)
  1177.       goto 23270
  1178. 23269 continue
  1179.       if(.not.(token.eq.-63))goto 23271
  1180.       callwhilec(lab)
  1181.       goto 23272
  1182. 23271 continue
  1183.       if(.not.(token.eq.-68))goto 23273
  1184.       callforcod(lab)
  1185.       goto 23274
  1186. 23273 continue
  1187.       if(.not.(token.eq.-69))goto 23275
  1188.       callrepcod(lab)
  1189.       goto 23276
  1190. 23275 continue
  1191.       if(.not.(token.eq.-60))goto 23277
  1192.       calllabelc(lexstr)
  1193.       goto 23278
  1194. 23277 continue
  1195.       if(.not.(token.eq.-62))goto 23279
  1196.       if(.not.(lextyp(sp).eq.-61))goto 23281
  1197.       callelseif(labval(sp))
  1198.       goto 23282
  1199. 23281 continue
  1200.       callsynerr(13hillegal else.)
  1201. 23282 continue
  1202. 23279 continue
  1203. 23278 continue
  1204. 23276 continue
  1205. 23274 continue
  1206. 23272 continue
  1207. 23270 continue
  1208. 23268 continue
  1209.       if(.not.(token.eq.-61.or.token.eq.-62.or.token.eq.-63.or.token.eq.
  1210.      &-68.or.token.eq.-69.or.token.eq.-66.or.token.eq.-60.or.token.eq.12
  1211.      &3))goto 23283
  1212.       sp=sp+1
  1213.       if(.not.(sp.gt.100))goto 23285
  1214.       callerror(25hstack overflow in parser.)
  1215. 23285 continue
  1216.       lextyp(sp)=token
  1217.       labval(sp)=lab
  1218.       goto 23284
  1219. 23283 continue
  1220.       if(.not.(token.eq.125))goto 23287
  1221.       if(.not.(lextyp(sp).eq.123))goto 23289
  1222.       sp=sp-1
  1223.       goto 23290
  1224. 23289 continue
  1225.       callsynerr(20hillegal right brace.)
  1226. 23290 continue
  1227.       goto 23288
  1228. 23287 continue
  1229.       if(.not.(token.eq.-67))goto 23291
  1230.       callotherc(lexstr)
  1231.       goto 23292
  1232. 23291 continue
  1233.       if(.not.(token.eq.-64.or.token.eq.-65))goto 23293
  1234.       callbrknxt(sp,lextyp,labval,token)
  1235. 23293 continue
  1236. 23292 continue
  1237. 23288 continue
  1238.       token=lex(lexstr)
  1239.       callpbstr(lexstr)
  1240.       callunstak(sp,lextyp,labval,token)
  1241. 23284 continue
  1242. 23265 token=lex(lexstr)
  1243.       goto 23264
  1244. 23266 continue
  1245.       if(.not.(sp.ne.1))goto 23295
  1246.       callsynerr(15hunexpected eof.)
  1247. 23295 continue
  1248.       return
  1249.       end
  1250.       subroutinepbstr(in)
  1251.       bytein(100)
  1252.       continue
  1253.       i=length(in)
  1254. 23297 if(.not.(i.gt.0))goto 23299
  1255.       callputbak(in(i))
  1256. 23298 i=i-1
  1257.       goto 23297
  1258. 23299 continue
  1259.       return
  1260.       end
  1261.       subroutineputbak(c)
  1262.       bytec
  1263.       integerbp
  1264.       bytebuf
  1265.       integer*1fordep
  1266.       byteforstk
  1267.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  1268.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  1269.      &2),vfor(2),vrept(2),vuntil(2)
  1270.       integerlevel
  1271.       integerlinect
  1272.       integerinfile
  1273.       integerlastp
  1274.       integerlastt
  1275.       integernamptr
  1276.       bytetable
  1277.       integeroutp
  1278.       byteoutbuf
  1279.       common/cdefio/bp,buf(300)
  1280.       common/cfor/fordep,forstk(200)
  1281.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  1282.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  1283.       common/cline/level,linect(5),infile(5)
  1284.       common/clook/lastp,lastt,namptr(200),table(1500)
  1285.       common/coutln/outp,outbuf(81)
  1286.       bp=bp+1
  1287.       if(.not.(bp.gt.300))goto 23300
  1288.       callerror(32htoo many characters pushed back.)
  1289. 23300 continue
  1290.       buf(bp)=c
  1291.       return
  1292.       end
  1293.       subroutineputch(c,f)
  1294.       bytebuf(81),c,c1,q1
  1295.       integerf
  1296.       datac1/1hC/,q1/1h?/
  1297.       datalastc/0/
  1298.       if(.not.(lastc.ge.81.or.c.eq.10))goto 23302
  1299.       if(.not.(lastc.gt.0))goto 23304
  1300.       write(f,1,err=5)(buf(i),i=1,lastc)
  1301.       goto4
  1302. 5     write(3,1)c1,q1
  1303. 4     continue
  1304. 1     format(1x,80a1)
  1305. 23304 continue
  1306.       lastc=0
  1307. 23302 continue
  1308.       if(.not.(c.ne.10))goto 23306
  1309.       lastc=lastc+1
  1310.       c=c.and.127
  1311.       if(.not.(c.lt.27))goto 23308
  1312.       c=c+33
  1313. 23308 continue
  1314.       buf(lastc)=c
  1315. 23306 continue
  1316.       return
  1317.       end
  1318.       subroutineputlin(b,f)
  1319.       byteb(100)
  1320.       integerf
  1321.       continue
  1322.       i=1
  1323. 23310 if(.not.(b(i).ne.-2))goto 23312
  1324.       callputch(b(i),f)
  1325. 23311 i=i+1
  1326.       goto 23310
  1327. 23312 continue
  1328.       return
  1329.       end
  1330.       subroutinerelate(token,last,fd)
  1331.       bytengetch,token(100),dotge(5),dotgt(5),dotle(5),dotne(5),dotnot(6
  1332.      &),doteq(5),dotand(6),dotor(5),dotlt(5)
  1333.       integerfd
  1334.       datadotge/46,103,101,46,-2/,dotgt/46,103,116,46,-2/,dotle/46,108,1
  1335.      &01,46,-2/,dotlt/46,108,116,46,-2/,dotne/46,110,101,46,-2/,doteq/46
  1336.      &,101,113,46,-2/,dotor/46,111,114,46,-2/,dotand/46,97,110,100,46,-2
  1337.      &/,dotnot/46,110,111,116,46,-2/
  1338.       if(.not.(ngetch(token(2),fd).ne.61))goto 23313
  1339.       callputbak(token(2))
  1340. 23313 continue
  1341.       if(.not.(token(1).eq.62))goto 23315
  1342.       if(.not.(token(2).eq.61))goto 23317
  1343.       callscopy(dotge,1,token,1)
  1344.       goto 23318
  1345. 23317 continue
  1346.       callscopy(dotgt,1,token,1)
  1347. 23318 continue
  1348.       goto 23316
  1349. 23315 continue
  1350.       if(.not.(token(1).eq.60))goto 23319
  1351.       if(.not.(token(2).eq.61))goto 23321
  1352.       callscopy(dotle,1,token,1)
  1353.       goto 23322
  1354. 23321 continue
  1355.       callscopy(dotlt,1,token,1)
  1356. 23322 continue
  1357.       goto 23320
  1358. 23319 continue
  1359.       if(.not.(token(1).eq.33))goto 23323
  1360.       if(.not.(token(2).eq.61))goto 23325
  1361.       callscopy(dotne,1,token,1)
  1362.       goto 23326
  1363. 23325 continue
  1364.       callscopy(dotnot,1,token,1)
  1365. 23326 continue
  1366.       goto 23324
  1367. 23323 continue
  1368.       if(.not.(token(1).eq.61))goto 23327
  1369.       if(.not.(token(2).eq.61))goto 23329
  1370.       callscopy(doteq,1,token,1)
  1371.       goto 23330
  1372. 23329 continue
  1373.       token(2)=-2
  1374. 23330 continue
  1375.       goto 23328
  1376. 23327 continue
  1377.       if(.not.(token(1).eq.38))goto 23331
  1378.       callscopy(dotand,1,token,1)
  1379.       goto 23332
  1380. 23331 continue
  1381.       if(.not.(token(1).eq.124))goto 23333
  1382.       callscopy(dotor,1,token,1)
  1383.       goto 23334
  1384. 23333 continue
  1385.       token(2)=-2
  1386. 23334 continue
  1387. 23332 continue
  1388. 23328 continue
  1389. 23324 continue
  1390. 23320 continue
  1391. 23316 continue
  1392.       last=length(token)
  1393.       return
  1394.       end
  1395.       subroutineremark(buf)
  1396.       bytebuf(100),pct
  1397.       datapct/1h%/
  1398.       continue
  1399.       j=1
  1400. 23335 if(.not.(j.lt.63.and.buf(j).ne.46))goto 23337
  1401.       buf(j)=buf(j).and.127
  1402.       if(.not.(buf(j).lt.27))goto 23338
  1403.       buf(j)=buf(j)+33
  1404. 23338 continue
  1405. 23336 j=j+1
  1406.       goto 23335
  1407. 23337 continue
  1408.       write(3,10,err=5)(buf(i),i=1,j)
  1409. 10    format(1x,63a1)
  1410.       return
  1411. 5     write(3,10)pct
  1412.       return
  1413.       end
  1414.       subroutinerepcod(lab)
  1415.       calloutcon(0)
  1416.       lab=labgen(3)
  1417.       calloutcon(lab)
  1418.       lab=lab+1
  1419.       return
  1420.       end
  1421.       subroutinescopy(from,i,to,j)
  1422.       bytefrom(100),to(100)
  1423.       k2=j
  1424.       continue
  1425.       k1=i
  1426. 23340 if(.not.(from(k1).ne.-2))goto 23342
  1427.       to(k2)=from(k1)
  1428.       k2=k2+1
  1429. 23341 k1=k1+1
  1430.       goto 23340
  1431. 23342 continue
  1432.       to(k2)=-2
  1433.       return
  1434.       end
  1435.       subroutinesynerr(msg)
  1436.       bytelc(81),msg(81)
  1437.       integerbp
  1438.       bytebuf
  1439.       integer*1fordep
  1440.       byteforstk
  1441.       bytesdo(3),sif(3),selse(5),swhile(6),sbreak(6),snext(5),sfor(4),sr
  1442.      &ept(7),suntil(6),vdo(2),vif(2),velse(2),vwhile(2),vbreak(2),vnext(
  1443.      &2),vfor(2),vrept(2),vuntil(2)
  1444.       integerlevel
  1445.       integerlinect
  1446.       integerinfile
  1447.       integerlastp
  1448.       integerlastt
  1449.       integernamptr
  1450.       bytetable
  1451.       integeroutp
  1452.       byteoutbuf
  1453.       common/cdefio/bp,buf(300)
  1454.       common/cfor/fordep,forstk(200)
  1455.       common/ckeywd/sdo,sif,selse,swhile,sbreak,snext,sfor,srept,suntil,
  1456.      &vdo,vif,velse,vwhile,vbreak,vnext,vfor,vrept,vuntil
  1457.       common/cline/level,linect(5),infile(5)
  1458.       common/clook/lastp,lastt,namptr(200),table(1500)
  1459.       common/coutln/outp,outbuf(81)
  1460.       callremark(14herror at line.)
  1461.       do 23343i=1,level
  1462.       callputch(32,3)
  1463.       junk=itoc(linect(i),lc,81)
  1464.       callputlin(lc,3)
  1465. 23343 continue
  1466. 23344 continue
  1467.       callputch(58,3)
  1468.       callputch(10,3)
  1469.       callremark(msg)
  1470.       return
  1471.       end
  1472.       bytefunctiontype(c)
  1473.       bytec
  1474.       if(.not.(c.ge.48.and.c.le.57))goto 23345
  1475.       type=2
  1476.       goto 23346
  1477. 23345 continue
  1478.       if(.not.((c.ge.97.and.c.le.122).or.(c.ge.65.and.c.le.90)))goto 233
  1479.      &47
  1480.       type=1
  1481.       goto 23348
  1482. 23347 continue
  1483.       type=c
  1484. 23348 continue
  1485. 23346 continue
  1486.       return
  1487.       end
  1488.       subroutineunstak(sp,lextyp,labval,token)
  1489.       integerlabval(100),sp
  1490.       bytelextyp(100),token
  1491.       continue
  1492. 23349 if(.not.(sp.gt.1))goto 23351
  1493.       if(.not.(lextyp(sp).eq.123.or.(lextyp(sp).eq.-61.and.token.eq.-62)
  1494.      &))goto 23352
  1495.       goto 23351
  1496. 23352 continue
  1497.       if(.not.(lextyp(sp).eq.-61))goto 23354
  1498.       calloutcon(labval(sp))
  1499.       goto 23355
  1500. 23354 continue
  1501.       if(.not.(lextyp(sp).eq.-62))goto 23356
  1502.       if(.not.(sp.gt.2))goto 23358
  1503.       sp=sp-1
  1504. 23358 continue
  1505.       calloutcon(labval(sp)+1)
  1506.       goto 23357
  1507. 23356 continue
  1508.       if(.not.(lextyp(sp).eq.-66))goto 23360
  1509.       calldostat(labval(sp))
  1510.       goto 23361
  1511. 23360 continue
  1512.       if(.not.(lextyp(sp).eq.-63))goto 23362
  1513.       callwhiles(labval(sp))
  1514.       goto 23363
  1515. 23362 continue
  1516.       if(.not.(lextyp(sp).eq.-68))goto 23364
  1517.       callfors(labval(sp))
  1518.       goto 23365
  1519. 23364 continue
  1520.       if(.not.(lextyp(sp).eq.-69))goto 23366
  1521.       calluntils(labval(sp),token)
  1522. 23366 continue
  1523. 23365 continue
  1524. 23363 continue
  1525. 23361 continue
  1526. 23357 continue
  1527. 23355 continue
  1528. 23350 sp=sp-1
  1529.       goto 23349
  1530. 23351 continue
  1531.       return
  1532.       end
  1533.       subroutineuntils(lab,token)
  1534.       byteptoken(200),token,junk,lex
  1535.       calloutnum(lab)
  1536.       if(.not.(token.eq.-70))goto 23368
  1537.       junk=lex(ptoken)
  1538.       callifgo(lab-1)
  1539.       goto 23369
  1540. 23368 continue
  1541.       calloutgo(lab-1)
  1542. 23369 continue
  1543.       calloutcon(lab+1)
  1544.       return
  1545.       end
  1546.       subroutinewhilec(lab)
  1547.       calloutcon(0)
  1548.       lab=labgen(2)
  1549.       calloutnum(lab)
  1550.       callifgo(lab+1)
  1551.       return
  1552.       end
  1553.       subroutinewhiles(lab)
  1554.       calloutgo(lab)
  1555.       calloutcon(lab+1)
  1556.       return
  1557.       end