文書整形 -- 指令の解析 ― 2016年12月05日 21:03
指令の解析は容易であり、comtyp()で行う。メインルーチンから呼び出される comand()から、最初にcomtyp()が呼び出される。comand()は、comtyp()の返す値に従い、 必要な処理を行っていく。comand()は以下の通りである。
RATFORでは、
# comand.r4 -- perform formatting command
subroutine comand( buf )
character buf(MAXLINE)
integer comtyp, getval
integer ct, spval, val
integer argtyp
include cpage.ri
include cparam.ri
ct = comtyp(buf)
if (ct == UNKOWN) # igore unknown commands
return
val = getval(buf,argtyp)
if (ct == FI) {
call brk
fill = YES
}
else if (ct == NF) {
call brk
fill = NOC
}
else if (ct == BR)
call brk
else if (ct == LS)
call set(lsval,val,argtyp,1,1,HUGE)
else if (ct == HE)
call gettl(buf,header)
else if (ct == FO)
call gettl(buf,footer)
else if (ct == SP) {
call set(spval,val,argtyp,1,0,HUGE)
call space(spval)
}
else if (ct == BP) {
if (lineno > 0)
call space(HUGE)
call set(curpage,val,argtyp,curpage+1,-HUGE,HUGE)
newpag = curpag
}
else if (ct == PL) {
call set(plval,val,argtyp,PAGELEN,m1val+m2val+m3val+m4val+1,HUGE)
bottom = plval - m3val - m4val
}
else if (ct == IN) {
call set(inval,val,argtyp,0,0,rmval-1)
tival = inval
}
else if (ct == RM)
call set(rmval,val,argtyp,PAGEWIDTH,tival+1,HUDGE)
else if (ct == TI) {
call brk
call set(tival,val,argtyp,0,0,rmval-1)
}
else if (ct == CE) {
call brk
call set(ceval,val,argtyp,1,0,HUGE)
}
else if (ct .eq. 14) then ! UL(14)
call set(ulval,val,argtyp,1,0,HUGE)
return
end
WATCOM fortran 77では、
c comand.f -- perform formatting command
subroutine comand( buf )
integer*1 buf(82) ! MAXLINE(82)
integer comtyp, getval
integer ct, spval, val
integer*1 argtyp
include cpage.fi
include cparam.fi
ct = comtyp(buf)
if (ct .eq. 0) then ! UNKOWN(0)
return
end if
val = getval(buf,argtyp)
if (ct .eq. 4) then ! FI(4)
call brk
fill = 1 ! YES(1)
else if (ct .eq. 9) then ! NF(9)
call brk
fill = 0 ! NOC(0)
else if (ct .eq. 2) then ! BR(2)
call brk
else if (ct .eq. 8) then ! LS(8)
call set(lsval,val,argtyp,1,1,1000) ! HUGE(1000)
else if (ct .eq. 6) then ! HE(6)
call gettl(buf,header)
else if (ct .eq. 5) then ! FO(5)
call gettl(buf,footer)
else if (ct .eq. 12) then ! SP(12)
call set(spval,val,argtyp,1,0,1000) ! HUGE(1000)
call space(spval)
else if (ct .eq. 1) then ! BP(1)
if (lineno .gt. 0) then
call space(1000) ! HUGE(1000)
end if
call set(curpage,val,argtyp,curpage+1,-1000,1000) ! HUGE(1000)
newpag = curpag
else if (ct .eq. 10) then ! PL(10)
call set(plval,val,argtyp,66, ! PAGELEN(66)
1 m1val+m2val+m3val+m4val+1,1000) ! HUGE(1000)
bottom = plval - m3val - m4val
else if (ct .eq. 7) then ! IN(7)
call set(inval,val,argtyp,0,0,rmval-1)
tival = inval
else if (ct .eq. 11) then ! RM(11)
call set(rmval,val,argtyp,60,tival+1,1000) ! PAGEWIDTH(60) HUGE(1000)
else if (ct .eq. 13) then ! TI(13)
call brk
call set(tival,val,argtyp,0,0,rmval-1)
else if (ct .eq. 3) then ! CE(3)
call brk
call set(ceval,val,argtyp,1,0,1000) ! HUGE(1000)
else if (ct .eq. 14) then ! UL(14)
call set(ulval,val,argtyp,1,0,1000) ! HUGE(1000)
end if
return
end
実際の指令の解析は、comtyp()が行う。
RATFOR版は、以下の通り。
c comtyp.r4 -- decode command type
integer function comtyp(buf)
character buf(MAXLINE)
if (buf(2) == LETB & buf(3) == LETP)
comtyp = BP
else if (buf(2) == LETB & buf(3) == LETR)
comtyp = BR
else if (buf(2) == LETC & buf(3) == LETE)
comtyp = CE
else if (buf(2) == LETF & buf(3) == LETI)
comtyp = FI
else if (buf(2) == LETF & buf(3) == LETO)
comtyp = FO
else if (buf(2) == LETH & buf(3) == LETE)
comtyp = HE
else if (buf(2) == LETI & buf(3) == LETN)
comtyp = IN
else if (buf(2) == LETL & buf(3) == LETS)
comtyp = LS
else if (buf(2) == LETN & buf(3) == LETF)
comtyp = NF
else if (buf(2) == LETP & buf(3) == LETL)
comtyp = PL
else if (buf(2) == LETR & buf(3) == LETM)
comtyp = RM
else if (buf(2) == LETS & buf(3) == LETP)
comtyp = SP
else if (buf(2) == LETT & buf(3) == LETI)
comtyp = TI
else if (buf(2) == LETU & buf(3) == LETL)
comtyp = UL
else
comtyp = UNKOWN
end if
return
end
WATCOM fortran77版は、以下の通り。
c comtyp.for -- decode command type
integer function comtyp(buf)
integer*1 buf(82) ! MAXLINE(82)
if ((buf(2) .eq. 98) .and. (buf(3) .eq. 112)) then ! LETB('b',98) LETP('p',112)
comtyp = 1 ! BP(1)
else if ((buf(2) .eq. 98) .and. (buf(3) .eq. 114)) then ! LETB('b',98) LETR('r',114)
comtyp = 2 ! BR(2)
else if ((buf(2) .eq. 99) .and. (buf(3) .eq. 101)) then ! LETC('c',99) LETE('r',101)
comtyp = 3 ! CE(3)
else if ((buf(2) .eq. 102) .and. (buf(3) .eq. 105)) then ! LETF('f',102) LETI('i',105)
comtyp = 4 ! FI(4)
else if ((buf(2) .eq. 102) .and. (buf(3) .eq. 111)) then ! LETF('f',102) LETO('o',111)
comtyp = 5 ! FO(5)
else if ((buf(2) .eq. 104) .and. (buf(3) .eq. 101)) then ! LETH('h',104) LETE('e',101)
comtyp = 6 ! HE(6)
else if ((buf(2) .eq. 105) .and. (buf(3) .eq. 110)) then ! LETI('i',105) LETN('n',110)
comtyp = 7 ! IN(7)
else if ((buf(2) .eq. 108) .and. (buf(3) .eq. 115)) then ! LETL('l',108) LETS('n',115)
comtyp = 8 ! LS(8)
else if ((buf(2) .eq. 110) .and. (buf(3) .eq. 102)) then ! LETN('n',110) LETF('f',102)
comtyp = 9 ! NF(9)
else if ((buf(2) .eq. 112) .and. (buf(3) .eq. 108)) then ! LETP('n',112) LETL('l',108)
comtyp = 10 ! PL(10)
else if ((buf(2) .eq. 114) .and. (buf(3) .eq. 109)) then ! LETR('r',114) LETM('m',109)
comtyp = 11 ! RM(11)
else if ((buf(2) .eq. 115) .and. (buf(3) .eq. 112)) then ! LETS('s',115) LETP('p',112)
comtyp = 12 ! SP(12)
else if ((buf(2) .eq. 116) .and. (buf(3) .eq. 105)) then ! LETT('t',116) LETI('i',105)
comtyp = 13 ! TI(13)
else if ((buf(2) .eq. 117) .and. (buf(3) .eq. 108)) then ! LETU('u',117) LETL('l',108)
comtyp = 14 ! UL(14)
else
comtyp = 0 ! UNKOWN(0)
end if
return
end
指令の引数は、getval()で取得する。取得した値は、set()で設定する。
getval()のRATFOR版は、以下の通り。
# getval.r4 - evaluate optional numeric argument
integer function getval(buf,argtyp)
character buf(MAXLINE)
integer ctoi
integer argtyp, i
i = 1 # skip command name
while (buf(i) != BLANK & buf(i) != TAB & buf(i) != NEWLINW)
i = i + 1
call skipbl(buf,i) # find argument
argtyp = buf(i)
if (argtyp == PLUS | argtyp == MINUS)
i = i + 1
getval = ctoi(buf,i)
return
end
WATCOM fortran版は、以下の通り。
c getval.for - evaluate optional numeric argument
integer function getval(buf,argtyp)
integer*1 buf(82) ! MAXLINE(82)
integer ctoi
integer argtyp, i
i = 1 ! skip command name
while ((buf(i) .ne. 32) ! BLANK(32)
1 .and. (buf(i) .ne. 9) ! TAB(9)
2 .and. (buf(i) .ne. 10)) do ! NEWLINE(10)
i = i + 1
end while
call skipbl(buf,i) ! find argument
argtyp = buf(i)
if ((argtyp .eq. 43) .or. (argtyp .eq. 45)) then ! PLUS('+',43) MINUS('-',45)
i = i + 1
end if
getval = ctoi(buf,i)
return
end
set()のRATFOR版は、以下の通り。
# set.r4 -- set parameter and check range
subroutine set( param, val, argtyp, defval, minval, maxval )
integer param, val, defval, minval, maxval
character argtyp
integer max,min
if (argtyp == NEWLINE)
param = defval
else if (argtyp == PLUS)
param = param + val
else if (argtyp == MINUS)
param = param - val
else
param = val
param = min( param, maxval )
param = max( param, minval )
return
end
WATCOM fortran版は、以下の通り。
c set.for -- set parameter and check range
subroutine set( param, val, argtyp, defval, minval, maxval )
integer param, val, defval, minval, maxval
integer*1 argtyp
integer max,min
if (argtyp .eq. 10) then ! defaulted NEWLINE(10)
param = defval
else if (argtyp .eq. 43) then ! relative + PLUS('+',43)
param = param + val
else if (argtyp .eq. 45) then ! relative - NIMUS('-',45)
param = param - val
else
param = val
endif
param = min( param, maxval )
param = max( param, minval )
return
end
最近のコメント