![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to overlay.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 / tst|
Return to overlay.f CVS log | Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 / tst |
1.1 root 1: subroutine ovlay
2: common ifld(400),ipc,ipb,ipa,inextb,ifr
3: common inextc,iresta,irestb,iquot,iaccb,iacca,ipb2,ipa2,ilp2
4: common ibufa,ibufb
5: c set,iipb2,iipa2,iiaccb,iacca
6: 111 format('tag')
7: 26 iacca=0
8: iaccb=0
9: 101 ipb2=ipb
10: ipa2=ipa
11: c set ibufa and bufb
12: ibufa=ifld(ipa)
13: ibufb=ifld(ipb)
14: c check if a's type is 'x'
15: iquot=ibufa/4
16: if (ibufa-4*iquot) 27,1,27
17: c check if a longer than b
18: 1 iquot=ibufa/4
19: iresta=iquot/64
20: iresta=iquot-64*iresta
21: 6 iquot=ibufb/4
22: irestb=iquot/64
23: irestb=iquot-64*irestb
24: iaccb=irestb+iaccb
25: 10 if (iresta.lt.iaccb) go to 7
26: c check length(in words) of b's record
27: iquot=ibufb/4
28: irestb=(ibufb-iquot*4)+1
29: ilp2=ipb2
30: go to(2,4,2,3)irestb
31: 2 ipb2=ipb2+1
32: go to 55
33: 3 if (ifld(ipb2+1).eq.-1) go to 5
34: 4 ipb2=ipb2+1
35: 5 ipb2=ipb2+2
36: c iaccumulate b's bits that overlay a's x'es
37: 55 ibufb=ifld(ipb2)
38: c check word's end
39: if (iresta.eq.iaccb) go to 22
40: go to 6
41: c check for single b record
42: 7 if (ipb.eq.ipb2)go to 27
43: c check if b's type is x
44: iquot=ifld(ipb2)/4
45: if (ifld(ipb2)-4*iquot) 1000,8,1000
46: c fill c with b's contents
47: 8 do 9 i=ipb,ipb2-1
48: ifld(ipc)=ifld(i)
49: ipc=ipc+1
50: 9 continue
51: ipb=ipb2
52: c create and insert record for a's tail
53: ilgth=iresta-(iaccb-irestb)
54: ifld(ipc)=ilgth*4
55: ipa=ipa+1
56: ipc=ipc+1
57: iaccb=-ilgth
58: iacca=ilgth
59: go to 101
60: c check if b's type is 'x'
61: 27 iquot=ibufb/4
62: if (ibufb-4*iquot) 20,11,20
63: c check if b longer than a
64: 11 iquot=ibufb/4
65: irestb=iquot/64
66: irestb=iquot-64*irestb
67: 115 iquot=ibufa/4
68: iresta=iquot/64
69: iresta=iquot-64*iresta
70: iacca=iresta+iacca
71: if (irestb.lt.iacca) go to 155
72: c check length(in words) of a record
73: iquot=ibufa/4
74: iresta=(ibufa-4*iquot)+1
75: ilp2=ipa2
76: go to (12,14,12,13) iresta
77: 12 ipa2=ipa2+1
78: go to 154
79: 13 if (ifld(ipa2+1).eq.-1) go to 15
80: 14 ipa2=ipa2+1
81: 15 ipa2=ipa2+2
82: c iaccumulate a's bits that overlay b's x'es
83: 154 ibufa=ifld(ipa2)
84: if (irestb.eq.iacca) go to 30
85: go to 115
86: c check for iaccumulate
87: 155 if (ipa.eq.ipa2) go to 1000
88: c check if a's type is 'x'
89: 16 iquot=ifld(ipa2)/4
90: if (ifld(ipa2)-4*iquot) 1000,18,1000
91: c fill c with a's contents
92: 18 do 19 i=ipa,ipa2-1
93: ifld(ipc)=ifld(i)
94: 19 ipc=ipc+1
95: ipa=ipa2
96: c create and insert record for b's trail
97: ilgth=irestb-(iacca-iresta)
98: ifld(ipc)=ilgth*4
99: c set new ipb,pointc,iacca,irestb
100: ipb=ipb+1
101: ipc=ipc+1
102: iacca=-ilgth
103: iaccb=ilgth
104: go to 101
105: c check for a=b
106: 20 iquot=ibufa/4
107: write(6,111)
108: iresta=(ibufa-4*iquot)+1
109: go to (201,202,203,204)iresta
110: 202 iresta=3
111: go to 201
112: 203 iresta=1
113: go to 201
114: 204 if (ifld(ipa+1).ne.-1) go to 202
115: iresta=3
116: 201 do 21 i=1,iresta
117: if(ifld(ipa).ne.ifld(ipb)) go to 1000
118: ifld(ipc)=ifld(ipa)
119: ipa=ipa+1
120: ipb=ipb+1
121: ipc=ipc+1
122: 21 continue
123: go to 26
124: c end of host word for first case a>=b
125: c fill c with b's content
126: 22 do 23 i=ipb,ipb2-1
127: ifld(ipc)=ifld(i)
128: ipc=ipc+1
129: 23 continue
130: if (ipb2-inextb+1) 25,24,24
131: 24 inextc=ipc
132: return
133: 25 ipa=ipa+1
134: ipb=ipb2
135: go to 26
136: c end of host word for 2nd case a<=b
137: c fill c with a's content
138: 30 do 31 i=ipa,ipa2-1
139: ifld(ipc)=ifld(i)
140: ipc=ipc+1
141: 31 continue
142: if (ipb-inextb+1) 35,34,34
143: 34 inextc=ipc
144: write (6,111)
145: return
146: 35 ipb=ipb+1
147: ipa=ipa2
148: go to 26
149: 1000 ifr=1
150: end
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.