Return to overlay.f CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1 / tst

Power 6/32 Unix version 1.21

	subroutine ovlay
	common ifld(400),ipc,ipb,ipa,inextb,ifr
	common inextc,iresta,irestb,iquot,iaccb,iacca,ipb2,ipa2,ilp2
	common ibufa,ibufb
c	set,iipb2,iipa2,iiaccb,iacca
111	format('tag')
26	iacca=0
	iaccb=0
101	ipb2=ipb
	ipa2=ipa
c	set ibufa and bufb
	ibufa=ifld(ipa)
	ibufb=ifld(ipb)
c	check if a's type is 'x'
	iquot=ibufa/4
	if (ibufa-4*iquot)  27,1,27
c	check if a longer than b
1	iquot=ibufa/4
	iresta=iquot/64
	iresta=iquot-64*iresta
6	iquot=ibufb/4
	irestb=iquot/64
	irestb=iquot-64*irestb
	iaccb=irestb+iaccb
10	if (iresta.lt.iaccb) go to 7
c	check length(in words) of b's record
	iquot=ibufb/4
	irestb=(ibufb-iquot*4)+1
	ilp2=ipb2
	go to(2,4,2,3)irestb
2	ipb2=ipb2+1
	go to 55
3	if (ifld(ipb2+1).eq.-1) go to 5
4	ipb2=ipb2+1
5	ipb2=ipb2+2
c	iaccumulate b's bits that overlay a's  x'es
55	ibufb=ifld(ipb2)
c	check word's end
	if (iresta.eq.iaccb) go to 22
	go to 6
c 	check for single b record
7	if (ipb.eq.ipb2)go to 27
c	check if b's type is x
	iquot=ifld(ipb2)/4
	if (ifld(ipb2)-4*iquot) 1000,8,1000
c	fill c with b's contents
8	do 9 i=ipb,ipb2-1
	ifld(ipc)=ifld(i)
	ipc=ipc+1
9	continue
	ipb=ipb2
c	create and insert record for a's tail
	ilgth=iresta-(iaccb-irestb)
	ifld(ipc)=ilgth*4
	ipa=ipa+1
	ipc=ipc+1
	iaccb=-ilgth
	iacca=ilgth
	go to 101
c	check if b's type is 'x'
27	iquot=ibufb/4
	if (ibufb-4*iquot) 20,11,20
c	check if b longer than a
11	iquot=ibufb/4
	irestb=iquot/64
	irestb=iquot-64*irestb
115	iquot=ibufa/4
	iresta=iquot/64
	iresta=iquot-64*iresta
	iacca=iresta+iacca
	if (irestb.lt.iacca) go to 155
c	check length(in words) of a record
	iquot=ibufa/4
	iresta=(ibufa-4*iquot)+1
	ilp2=ipa2
	go to (12,14,12,13) iresta
12	ipa2=ipa2+1
	go to 154
13	if (ifld(ipa2+1).eq.-1) go to 15
14	ipa2=ipa2+1
15	ipa2=ipa2+2
c	iaccumulate a's bits that overlay b's x'es
154	ibufa=ifld(ipa2)
	if (irestb.eq.iacca) go to 30
	go to 115
c	check for iaccumulate
155	if (ipa.eq.ipa2)  go to 1000
c	check if a's type is 'x'
16	iquot=ifld(ipa2)/4
	if (ifld(ipa2)-4*iquot) 1000,18,1000
c	fill c with a's contents
18	do 19 i=ipa,ipa2-1
	ifld(ipc)=ifld(i)
19	ipc=ipc+1
	ipa=ipa2
c	create and insert record for b's trail
	ilgth=irestb-(iacca-iresta)
	ifld(ipc)=ilgth*4
c	set new ipb,pointc,iacca,irestb
	ipb=ipb+1
	ipc=ipc+1
	iacca=-ilgth
	iaccb=ilgth
	go to 101
c  	check for a=b
20	iquot=ibufa/4
	write(6,111)
	iresta=(ibufa-4*iquot)+1
	go to (201,202,203,204)iresta
202	iresta=3
	go to 201
203	iresta=1
	go to 201
204	if (ifld(ipa+1).ne.-1) go to 202
	iresta=3
201	do 21 i=1,iresta
	if(ifld(ipa).ne.ifld(ipb)) go to 1000
	ifld(ipc)=ifld(ipa)
	ipa=ipa+1
	ipb=ipb+1
	ipc=ipc+1
21	continue
	go to 26
c	end of host word for first case a>=b
c	fill c with b's content
22	do 23 i=ipb,ipb2-1
	ifld(ipc)=ifld(i)
	ipc=ipc+1
23	continue
	if (ipb2-inextb+1) 25,24,24
24	inextc=ipc
	return
25	ipa=ipa+1
	ipb=ipb2
	go to 26
c	end of host word for  2nd case a<=b
c	fill c with a's content
30	do 31 i=ipa,ipa2-1
	ifld(ipc)=ifld(i)
	ipc=ipc+1
31	continue
	if (ipb-inextb+1) 35,34,34
34	inextc=ipc
	write (6,111)
	return
35	ipb=ipb+1
	ipa=ipa2
	go to 26
1000	ifr=1
	end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.