All articles in a thread |
---|
ftnchekを用いた、syntax checkで判明している引数不足な呼び出し Active file中で発生している呼び出し不整合(Invoked argc < Defined argc) 定義 呼び出しもと doelem@doelem.f toplvl.f termes@termes.f mkmachinef@initdainterface.f pasex@pasex.f mccor.f msolv1@msolv1.f msolv.f chkflst@pfalloc.f itfmessageexp@itfmessage.f tfconvstr@tfconvstr.f tffile.f,pstati.f,preadstr.f,preadmon.f,petune.f tthin@tquad.f tquads.f,tstrad.f tthine@tthine.f tturne.f ttstat@ttstat.f track.f undulator@undulator.f tturn.f Obsolete file中の非互換関数 tfreev@itfaloc1.f tvset@itfaloc1.f tfearray@tfearray1.f |
> doelem@doelem.f > termes@termes.f > mkmachinef@initdainterface.f > pasex@pasex.f への修正 pasexの呼び出しもと mccor.fの修正は怪しいが ``Orbit Correction commands will be removed soon'' らしいので、問題ない?(Ref. mcmess@tffsa.f) ----PATCH---- Index: src/tfvars.f =================================================================== --- src/tfvars.f (revision 363) +++ src/tfvars.f (working copy) @@ -89,7 +89,7 @@ if(ierrorprint .ne. 0)then call tfaddmessage(irtc,' ',2,6) endif - call termes(6,'Error in VariableRange '// + call termes(6,'Error in VariableRange ', $ pname(k)(1:lenw(pname(k)))//' '//key(1:lenw(key))) do j=i,nvar call tfsetlist(ntfoper,mtfnull,0.d0,iax,j) Index: src/tffsa.f =================================================================== --- src/tffsa.f (revision 363) +++ src/tffsa.f (working copy) @@ -1035,9 +1035,8 @@ go to 12 elseif(abbrev(word,'COR_RECT','_')) then call mcmess(lfno) - call mccor(word,ilist(1,ilattp+1),rlist(iftwis),rlist(ifgamm), - $ ilist(1,ifmult), - $ ilist(1,ifmast),kfit,ifitp, + call mccor(word,ilist(1,ilattp+1),rlist(ifpos),rlist(iftwis), + $ rlist(ifgamm),ilist(1,ifmult),ilist(1,ifmast),kfit,ifitp, 1 mfitp,fitval,nfc,rlist(itstr),rlist(itestr),nster, 1 rlist(itmon),rlist(itemon),nmon,newcor,lfno) go to 12 Index: src/doelem.f =================================================================== --- src/doelem.f (revision 363) +++ src/doelem.f (working copy) @@ -1,7 +1,5 @@ - subroutine doelem(elmcd,dummy) + subroutine doelem(elmcd) implicit none - integer elmcd - real*8 dummy c include 'inc/MACCBK.inc' include 'inc/MACFUN.inc' @@ -10,6 +8,7 @@ include 'inc/MACTTYP.inc' include 'inc/MACCODE.inc' include 'inc/MACKW.inc' + integer*4 elmcd character*(MAXSTR) token,wtoken*(*) integer slen,ival,ttype,hsrchz,slen2,ttype2,idx real*8 rval Index: src/mccor.f =================================================================== --- src/mccor.f (revision 363) +++ src/mccor.f (working copy) @@ -1,4 +1,4 @@ - subroutine mccor(word,latt,twiss,gammab,mult,master,kfit,ifitp, + subroutine mccor(word,latt,pos,twiss,gammab,mult,master,kfit,ifitp, $ mfitp,fitval,nfc,istr,estr,nstr,imon,emon,nmon,newcor,lfno) c -**** Main routine for orbit correction ****-------------------------- c Note @@ -23,7 +23,7 @@ logical stab,cod,dsp,normal,xplane,yplane,both,bump,minusi,micado, 1 cond,zsum,exist,exec,coup,operate logical corc(nkey),corcn(nkey),corca(nobj),method(nobj,nmeth) - dimension latt(2,nlat),twiss(nlat,-ndim:ndim,ntwissfun), + dimension latt(2,nlat),pos(nlat),twiss(nlat,-ndim:ndim,ntwissfun), $ gammab(nlat),mult(nlat),master(nlat) dimension dp1(-ndim:ndim) dimension istr(nstra,4),imon(nmona,4),emon(*),estr(*) @@ -373,9 +373,9 @@ c z istr,istr(1,2),estr,nstr,imon, c z nmon,corc,lfno) else - call pasex(word,latt,twiss,mult, - $ gammab,istr,estr,nstr,imon,emon, - $ nmon,lstack,lfno) + call pasex(word,latt,pos,twiss,mult,master, + $ gammab,' ',' ',istr,estr,nstr,imon,emon,nmon, + $ lfno) endif exit endif Index: src/initdainterface.f =================================================================== --- src/initdainterface.f (revision 363) +++ src/initdainterface.f (working copy) @@ -16,9 +16,9 @@ return endif if(itastk(1,isp) .eq. ntfreal)then !Check the type of arg - call mkmachinef nord=vstk(ivstkoffset+isp) nvar=6 + call mkmachinef(nord) call initda(nord,lvec) !If real, vstk(ivstkoffset+isp1+i)has c !the i-th value. itx=ntfoper !Type of return value of function. ----PATCH---- |
もうすこし、まじめに直したパッチ 前の奴は、mccor.fで72桁を越えるというenbugが... Fix proto-type of yyerror() src/yylex.f Fix API mismatch of undularor() invoke Remove unused `iturn' argument Rename argument name `work' to `pz' src/undulator.f Fix API mismatch of mkmachinef() invoke src/initdainterface.f Fix API mismatch of termes() invoke src/tfvars.f Redirect API call prmmap@malloc.f/prmmap.f(obsolete) to pr_mem_map@pfalloc.f src/ActLie.f src/ActTra.f src/doACT.f src/dolist.f Fix API mismatch of doelem() invoke Remove `dummy' argument Fix argument type(Integer -> Integer*4) src/doelem.f Fix API mismatch of pasex() invoke mccor() API is changed to obtain pos argument for pasex src/mccor.f src/tffsa.f ----PATCH---- Index: src/undulator.f =================================================================== --- src/undulator.f (revision 382) +++ src/undulator.f (revision 390) @@ -1,5 +1,5 @@ C 18/01/93 303061342 MEMBER NAME UNDULATOR *.FORT M E2FORT - subroutine undulator(np,x,px,y,py,z,g,dv,work,ulist,iturn) + subroutine undulator(np,x,px,y,py,z,g,dv,pz,ulist) ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc c c c Undulator tracking subroutine. c @@ -14,7 +14,7 @@ c implicit none parameter (nsli=1,npole=2,len=3,i_F0=4,i_G0=5,i_dph=6, & i_Kz=7,i_Kx=8,i_Ky=9,i_Qx=10,i_Qy=11,lambda=12,i_ds=13) - real*8 x(np),px(np),y(np),py(np),z(np),g(np),dv(np),work(np) + real*8 x(np),px(np),y(np),py(np),z(np),g(np),dv(np),pz(np) real*8 ulist(*) real*8 sinkz,sinkzp real*8 kx1,kx2,kx3,kx4,ff,gg,fx,fy,gx,gy,dpds Index: src/tfvars.f =================================================================== --- src/tfvars.f (revision 382) +++ src/tfvars.f (revision 390) @@ -89,7 +89,7 @@ if(ierrorprint .ne. 0)then call tfaddmessage(irtc,' ',2,6) endif - call termes(6,'Error in VariableRange '// + call termes(6,'Error in VariableRange ', $ pname(k)(1:lenw(pname(k)))//' '//key(1:lenw(key))) do j=i,nvar call tfsetlist(ntfoper,mtfnull,0.d0,iax,j) Index: src/yylex.f =================================================================== --- src/yylex.f (revision 382) +++ src/yylex.f (revision 390) @@ -99,7 +99,10 @@ return end c - subroutine yyerror() + subroutine yyerror(msg) + implicit none + character*(*) msg + write (*,*) 'LALR(1) parser: ', msg return end c Index: src/ActTra.f =================================================================== --- src/ActTra.f (revision 382) +++ src/ActTra.f (revision 390) @@ -211,7 +211,7 @@ c print *,np,nt,p0,charge,mass,sync,ex,ey,sigs,sige c c.....construct initial value list. -c call prmmap +c call pr_mem_map c if(igetgl('$COD$',idummy) .ne. 0)then c call twis(pexln,idxtws,.true.) c endif Index: src/tffsa.f =================================================================== --- src/tffsa.f (revision 382) +++ src/tffsa.f (revision 390) @@ -1035,9 +1035,8 @@ go to 12 elseif(abbrev(word,'COR_RECT','_')) then call mcmess(lfno) - call mccor(word,ilist(1,ilattp+1),rlist(iftwis),rlist(ifgamm), - $ ilist(1,ifmult), - $ ilist(1,ifmast),kfit,ifitp, + call mccor(word,ilist(1,ilattp+1),rlist(ifpos),rlist(iftwis), + $ rlist(ifgamm),ilist(1,ifmult),ilist(1,ifmast),kfit,ifitp, 1 mfitp,fitval,nfc,rlist(itstr),rlist(itestr),nster, 1 rlist(itmon),rlist(itemon),nmon,newcor,lfno) go to 12 Index: src/doelem.f =================================================================== --- src/doelem.f (revision 382) +++ src/doelem.f (revision 390) @@ -1,7 +1,5 @@ - subroutine doelem(elmcd,dummy) + subroutine doelem(elmcd) implicit none - integer elmcd - real*8 dummy c include 'inc/MACCBK.inc' include 'inc/MACFUN.inc' @@ -10,6 +8,7 @@ include 'inc/MACTTYP.inc' include 'inc/MACCODE.inc' include 'inc/MACKW.inc' + integer*4 elmcd character*(MAXSTR) token,wtoken*(*) integer slen,ival,ttype,hsrchz,slen2,ttype2,idx real*8 rval Index: src/ActLie.f =================================================================== --- src/ActLie.f (revision 382) +++ src/ActLie.f (revision 390) @@ -24,9 +24,9 @@ & 'Expanding '//pname(nidx)//' now.',0,0) call expnln(nidx) endif - call prmmap + call pr_mem_map c call prexln(nidx,' ') call AAALIE(nidx) - call prmmap + call pr_mem_map return end Index: src/doACT.f =================================================================== --- src/doACT.f (revision 382) +++ src/doACT.f (revision 390) @@ -93,7 +93,7 @@ call errmsg('doact'//pname(cmdidx)(2:), & ' break memory area.',0,0) c stop 9999 - call prmmap + call pr_mem_map endif ilist(1,membas)=memuse call freeme(membas+memuse,restme-memuse) Index: src/mccor.f =================================================================== --- src/mccor.f (revision 382) +++ src/mccor.f (revision 390) @@ -1,5 +1,7 @@ - subroutine mccor(word,latt,twiss,gammab,mult,master,kfit,ifitp, - $ mfitp,fitval,nfc,istr,estr,nstr,imon,emon,nmon,newcor,lfno) + subroutine mccor(word,latt,pos,twiss, + $ gammab,mult,master,kfit,ifitp, + $ mfitp,fitval,nfc,istr,estr,nstr, + $ imon,emon,nmon,newcor,lfno) c -**** Main routine for orbit correction ****-------------------------- c Note c . Subroutines for correction use the array TWISS as a buffer area: @@ -23,7 +25,7 @@ logical stab,cod,dsp,normal,xplane,yplane,both,bump,minusi,micado, 1 cond,zsum,exist,exec,coup,operate logical corc(nkey),corcn(nkey),corca(nobj),method(nobj,nmeth) - dimension latt(2,nlat),twiss(nlat,-ndim:ndim,ntwissfun), + dimension latt(2,nlat),pos(nlat),twiss(nlat,-ndim:ndim,ntwissfun), $ gammab(nlat),mult(nlat),master(nlat) dimension dp1(-ndim:ndim) dimension istr(nstra,4),imon(nmona,4),emon(*),estr(*) @@ -373,9 +375,9 @@ c z istr,istr(1,2),estr,nstr,imon, c z nmon,corc,lfno) else - call pasex(word,latt,twiss,mult, - $ gammab,istr,estr,nstr,imon,emon, - $ nmon,lstack,lfno) + call pasex(word,latt,pos,twiss,mult,master, + $ gammab,' ',' ',istr,estr,nstr,imon,emon,nmon, + $ lfno) endif exit endif Index: src/dolist.f =================================================================== --- src/dolist.f (revision 382) +++ src/dolist.f (revision 390) @@ -131,7 +131,7 @@ $ '(1H ,''used Hash table='',I5,''/'',I5)') $ used, HTMAX if (Lmem) then - call prmmap + call pr_mem_map endif return end Index: src/initdainterface.f =================================================================== --- src/initdainterface.f (revision 382) +++ src/initdainterface.f (revision 390) @@ -16,9 +16,9 @@ return endif if(itastk(1,isp) .eq. ntfreal)then !Check the type of arg - call mkmachinef nord=vstk(ivstkoffset+isp) nvar=6 + call mkmachinef(nord) call initda(nord,lvec) !If real, vstk(ivstkoffset+isp1+i)has c !the i-th value. itx=ntfoper !Type of return value of function. ----PATCH---- |
まだ、修正が用意されて無いもの `argc of Invoke > Define > 0'のケースに関しては、「syntax的には問題ない」 との主張もあるが、次の理由から修正の必要があると思う * 必要の無いものを stackに積む時間と stack depthが無駄(performance) * code上で、引数が整合しない理由が明らかでない(debugの妨げになる) * 意図して渡したものを受け取らないAPI設計はおかしい(semantics) Subprogram varying number of arguments(argc of Define > Invoke) itfmessageexp@itfmessage.f tfsetlistr@tfeval1.f tfconvstr@tfconvstr.f tffile@tffile.f preadstr@preadstr.f, pstati@pstati.f preadmon@preadmon.f, petune@petune.f msolv1@msolv1.f msolv@msolv.f tthin@tquad.f tquads@tquads.f, tstrad@tstrad.f tthine@tthine.f tturne1@tturne.f trad@trad.f tquads@tquads.f ttstat@ttstat.f tracka@tracka.f Subprogram varying number of arguments(argc of Invoke > Define > 0) qtwiss@qtwiss.f tfltr1@tfltr1.f pfrmat@pasex.f pasex2@pasex.f, pasex3@pasex.f tftmat@tftmat.f qins@qins.f qgettr@qgettr.f tfltr1@tfltr1.f |
tthin@tquad.f tquads@tquads.f, tstrad@tstrad.f tthine@tthine.f tturne1@tturne.f trad@trad.f tquads@tquads.f ttstat@ttstat.f tracka@tracka.f 用のパッチ 自信が無いのでだれか査読して! ----PATCH---- Index: src/tquad.f =================================================================== --- src/tquad.f (revision 363) +++ src/tquad.f (working copy) @@ -7,8 +7,8 @@ integer*4 ndiv,np,l real*8 x(np),px(np),y(np),py(np),z(np),dv(np),g(np),pz(np) if(al .le. 0.d0)then - call tthin(np,x,px,y,py,z,g,dv,pz, - 1 4,l,0.d0,ak,dx,dy,theta,cost,sint, 1.d0,.false.) + call tthin(np,x,px,y,py,z,g,dv,pz,4,l,0.d0,ak, + $ dx,dy,theta,cost,sint, 1.d0,.false.) return elseif(ak .eq. 0.d0)then call tdrift(np,x,px,y,py,z,g,dv,pz,al, Index: src/tturne.f =================================================================== --- src/tturne.f (revision 376) +++ src/tturne.f (working copy) @@ -274,7 +274,7 @@ $ rlist(lp+13),rlist(lp+14) .eq. 0.d0,ld) go to 1010 1600 call tthine(trans,cod,beam,beamr,lele,al,rlist(lp+2), - 1 rlist(lp+5),rlist(lp+6),rlist(lp+4),ld) + 1 rlist(lp+5),rlist(lp+6),rlist(lp+4),.false.,ld) go to 1010 3000 call tsole(trans,cod,beam,beamr,latt,l,ke,sol, 1 twiss,size,gammab,iatr,iacod,iabmi,ndim,plot) Index: src/tracka.f =================================================================== --- src/tracka.f (revision 363) +++ src/tracka.f (working copy) @@ -35,8 +35,8 @@ if(trpt)then call ttinit(latt,x,px,y,py,z,g,dv,pz) call ttstat(np0,x,px,y,py,z,g,dv,pz, - 1 'Entrance',sa,ss,es,.true., - 1 outfl) + 1 'Entrance',sa,ss,es, + $ .false.,.true.,outfl) else call tinip(np,x,px,y,py,z,g,dv,pz,emx,emz,codin,cmplot) endif @@ -210,7 +210,8 @@ enddo 1010 if(trpt .and. outfl .gt. 0)then call ttstat(np,x,px,y,py,z,g,dv,pz, - 1 'Exit',sa,ss,es,.true.,outfl) + 1 'Exit',sa,ss,es, + $ .false.,.true.,outfl) else lfnplt=nint(rgetgl1('PHSPLOTS')) if(lfnplt .gt. 0)then Index: src/tquads.f =================================================================== --- src/tquads.f (revision 363) +++ src/tquads.f (working copy) @@ -20,8 +20,8 @@ ilist(2,ifv+1)=italoc(2)-2 endif if(al .le. 0.d0)then - call tthin(np,x,px,y,py,z,g,dv,pz, - 1 4,0.d0,ak,dx,dy,theta,cost,sint, 1.d0,.false.) + call tthin(np,x,px,y,py,z,g,dv,pz,4,ld,0.d0,ak, + $ dx,dy,theta,cost,sint, 1.d0,.false.) return endif enarad=rad .and. radlvl .ne. 1.d0 @@ -66,7 +66,7 @@ if(enarad)then b1=brho*ak/al call trad(np,x,px,y,py,g,dv,0.d0, - 1 b1,0.d0,.5d0*al,1.d0) + 1 b1,0.d0,0.d0,.5d0*al, 1.d0) endif if(ifv .eq. 0)then call tsolqu(np,x,px,y,py,z,g,dv,pz,al,ak,bz,0.d0,0.d0,eps0) @@ -124,8 +124,7 @@ endif if(enarad)then call trad(np,x,px,y,py,g,dv,0.d0, - 1 b1,0.d0, - 1 .5d0*al,-1.d0) + 1 b1,0.d0,0.d0,.5d0*al,-1.d0) endif if(mfring .eq. 2 .or. mfring .eq. 3)then do 2120 i=1,np Index: src/tstrad.f =================================================================== --- src/tstrad.f (revision 363) +++ src/tstrad.f (working copy) @@ -12,7 +12,7 @@ 1 cosp1,sinp1,cosp2,sinp2 if(al .le. 0.d0)then call tthin(np,x,px,y,py,z,g,dv,pz,2,l,al,-phib, - 1 dx,dy,theta,cost,sint,.false.) + 1 dx,dy,theta,cost,sint,1.d0,.false.) return elseif(phib .eq. 0.d0)then call tdrift(np,x,px,y,py,z,g,dv,pz,al,0.d0,0.d0,0.d0) ----PATCH---- |
LTR_ACK FFS level commandの実装に係わる src/tfltr1.fからの |
src/msolv.fから msolv1への呼び出し時の引数列が |
> > Subprogram varying number of arguments(argc of Define > Invoke) > itfmessageexp@itfmessage.f tfsetlistr@tfeval1.f > tfconvstr@tfconvstr.f tffile@tffile.f > preadstr@preadstr.f, pstati@pstati.f > preadmon@preadmon.f, petune@petune.f たぶにこれで正しい ----PATCH---- Index: src/petune.f =================================================================== --- src/petune.f (revision 390) +++ src/petune.f (revision 393) @@ -73,7 +73,7 @@ write(word,'(''ftn'',i2.2)') lfni1 elseif(itype.eq.101) then call cssetp(next) - word=tfconvstr(101,ia,x,nc) + word=tfconvstr(101,ia,x,nc,'*') if(word.eq.' ') then call permes('?Missing filename for BTUNE HISTORY','.',' ', $ lfno) Index: src/tffile.f =================================================================== --- src/tffile.f (revision 390) +++ src/tffile.f (revision 393) @@ -60,7 +60,7 @@ lfopen(lfnp)=.false. elseif(itype .eq. ntfstring)then call cssetp(next) - word=tfconvstr(ntfstring,ia,x,nc) + word=tfconvstr(ntfstring,ia,x,nc,'*') do 8020 j=51,97 do 8030 i=lfnb,lfnp if(j .eq. lfnstk(i))then @@ -143,7 +143,7 @@ lfno1=98 close(lfno1) call cssetp(next) - word=tfconvstr(ntfstring,ia,x,nc) + word=tfconvstr(ntfstring,ia,x,nc,'*') c write(*,*)'tffile-1 ',word(1:lnblnk(word)) call texpfn(word) c write(*,*)'tffile-2 ',word(1:lnblnk(word)) Index: src/preadmon.f =================================================================== --- src/preadmon.f (revision 390) +++ src/preadmon.f (revision 393) @@ -22,7 +22,7 @@ write(word,'(''ftn'',i2.2)') lfni1 elseif(itype.eq.101) then call cssetp(next) - word=tfconvstr(101,ia,x,nc) + word=tfconvstr(101,ia,x,nc,'*') if(word.eq.' ') then call permes('?Missing filename for MONREAD','.',' ',lfno) call getwdl(word) Index: src/tfeval1.f =================================================================== --- src/tfeval1.f (revision 390) +++ src/tfeval1.f (revision 393) @@ -571,10 +571,10 @@ include 'inc/TFCODE.inc' integer*4 it,ia,ia1,irtc,itx,iax,iv, $ iav,iad,itadattach,itfcopy,i,italoc, - $ itfmessage,itfcopy1,itfmessageexp + $ itfmessage,itfcopy1 real*8 v,vx if(ia1 .le. 0)then - irtc=itfmessageexp(999, + irtc=itfmessage(999, $ 'General::invset','"a strange object"') return endif Index: src/mckick.f =================================================================== --- src/mckick.f (revision 390) +++ src/mckick.f (revision 393) @@ -27,7 +27,7 @@ c elseif(itype.eq.101) then c print *,itype c call cssetp(next) -c word=tfconvstr(101,ia,x,nc) +c word=tfconvstr(101,ia,x,nc,'*') c if(word.eq.' ') then c call permes('?Missing element for KICK','.',' ',6) c call getwdl(word) Index: src/preadstr.f =================================================================== --- src/preadstr.f (revision 390) +++ src/preadstr.f (revision 393) @@ -23,7 +23,7 @@ write(word,'(''ftn'',i2.2)') lfni1 elseif(itype.eq.101) then call cssetp(next) - word=tfconvstr(101,ia,x,nc) + word=tfconvstr(101,ia,x,nc,'*') if(word.eq.' ') then call permes('?Missing filename for MONREAD','.',' ',lfno) call getwdl(word) Index: src/pstati.f =================================================================== --- src/pstati.f (revision 390) +++ src/pstati.f (revision 393) @@ -69,7 +69,7 @@ write(word,'(''ftn'',i2.2)') lfni1 elseif(itype.eq.101) then call cssetp(next) - word=tfconvstr(101,ia,x,ncc) + word=tfconvstr(101,ia,x,ncc,'*') if(word.eq.' ') then call permes('?Missing filename for SUM','.',' ',lfno) call getwdl(word) ---PATCH--- |
一応、全部直して MAIN trunkにも backportした |