getccl()のRATFOR版は下記の通り。
# getccl.r4 -- expand char class at atg(i) into pat(j) integer function getccl(arg,i,pat,j) character arg(MAXARG),pat(MAXPAT) integer i,j integer addset,junk,jstart i = i + 1 if (arg(i) == NOT) { junk = addset(NCCL,pat,j,MAXPAT) i = i + 1 } else junk = addset(CCL,pat,j,MAXPAT) jstart = j junk = addset(0,pat,j,MAXPAT) # leave room for count call filset(CCLEND,arg,i,pat,j,MAXPAT) pat(jstart) = j - jstart - 1 if (arg(i) == CCLEND) getccl = OK else getccl = ERR return end
WATCOM Fortran77版は下記の通り。
c getccl.for -- expand char class at atg(i) into pat(j) integer function getccl(arg,i,pat,j) integer*1 arg(81),pat(81) ! MAXARG(81) MAXPAT(81) integer i,j integer addset,junk,jstart i = i + 1 if (arg(i) .eq. 33) then ! NOT(33 '!') junk = addset(110,pat,j,81) ! NCCL(110, 'n') MAXPAT(81) i = i + 1 else junk = addset(91,pat,j,81) ! CCL(91, '[') MAXPAT(81) end if jstart = j junk = addset(0,pat,j,81) ! leave room for count MAXPAT(81) call filset(93,arg,i,pat,j,81) ! COLEND(93 ']') MAXPAT(81) pat(jstart) = j - jstart - 1 ! save count if (arg(i) .eq. 93) then ! COLEND(93 ']') getccl = 1 ! OK(1) else getccl = -1 ! ERR(-1) end if return end
stclos()のRATFOR版は下記の通り。
# stclos.r4 -- insert closure entry at pat(j) integer function stclos(pat,j,lastj,lastcl) character pat(MAXPAT) integer j,junk,jp,jt,lastj,lastcl integer addset, for (jp = j - 1; jp >= lastj; jp = jp - 1) { make a hole jt = jp + COLSIZE junk = addset(pat(jp),pat,jt,MAXPAT) } j = j + CLOSIZE stclos = lastj junk = addset(CLOSURE,pat,lastj,MAXPAT) # put closure in it junk = addset(0,pat,lastj,MAXPAT) # COUNT junk = addset(lastcl,pat,lastj,MAXPAT) # PREVCL junk = addset(0,pat,lastj,MAXPAT) # START return end
WATCOM Fortran77版は下記の通り。
※コメントの受付件数を超えているため、この記事にコメントすることができません。