![[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.