文書整形 -- 指令の解析 ― 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
最近のコメント