組み込み関数"ifelse"の実装は以下の通り。

RATFOR版

# doif.f -- select one of two arguments
      include ratfor.def
      subroutine doif(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer equal
      integer a2,a3,a4,a5

      include cmacro.ri

      if (j-i < 5)
          return

      a2 = argstk(i + 2)
      a3 = argstk(i + 3)
      a4 = argstk(i + 4)
      a5 = argstk(i + 5)

      if (equal(evalst(a2),evalst(a3)) == YES)
          call pbstr(evalst(a4))
      else
          call pbstr(evalst(a5))
      return
      end

WATCOM Fortran 77版は以下の通り。

c doif.f -- select one of two arguments
      include ratfor.def
      subroutine doif(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer equal
      integer a2,a3,a4,a5

      include cmacro.fi

      if (j-i .lt. 5) then
          return
      end if

      a2 = argstk(i + 2)
      a3 = argstk(i + 3)
      a4 = argstk(i + 4)
      a5 = argstk(i + 5)

      if (equal(evalst(a2),evalst(a3)) .eq. YES) then
          call pbstr(evalst(a4))
      else
          call pbstr(evalst(a5))
      end if
      return
      end

組み込み関数"incr"は、引数を数値化して、下請けルーチンpbnum()で+1し、文字列化して入力に戻す。"incr"の実装は 以下の通り。

RATFOR版

# doinc.r4 -- increment argument by 1
      include ratfor.def
      subroutine doincr(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer ctoi
      integer k

      include cmacro.ri

      k = argstk(i+2)
      call pbnum(ctoi(evalst,k)+1)
      return
      end

WATCOM Fortran 77版は以下の通り。

c doinc.f -- increment argument by 1
      include ratfor.def
      subroutine doinc(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer ctoi
      integer k

      include cmacro.fi

      k = argstk(i+2)
      call pbnum(ctoi(evalst,k)+1)
      return
      end

下請けルーチンpbnum()は以下の通り。

RATFOR版は以下の通り。

# pbnum.r4 -- convert number to string, push back on input
      include ratfor.def
      subroutine pbnum(n)
      integer n
      integer mod
      integer m,num
      string digits "0123456789"

      num = n
      repeat {
          m = mod(num,10)
          call putbak(digits(m+1))
          num = num/10
          } until (num == 0)
      return
      end

WATCOM Fortran 77版は以下の通り。

c pbnum.f -- convert number to string, push back on input
      include ratfor.def
      subroutine pbnum(n)
      integer n
      integer mod
      integer m,num
      integer*1 digits(11)
      data digits(1)/LET0/
      data digits(2)/LET1/
      data digits(3)/LET2/
      data digits(4)/LET3/
      data digits(5)/LET4/
      data digits(6)/LET5/
      data digits(7)/LET6/
      data digits(8)/LET7/
      data digits(9)/LET8/
      data digits(10)/LET9/
      data digits(11)/EOS/

      num = n
      loop
          m = mod(num,10)
          call putbak(digits(m+1))
          num = num/10
      until (num .eq. 0)
      return
      end

組み込み関数"substr"の実装は、以下の通り。

RATFOR版は以下の通り。

# dosub.r4 -- select substring
      include ratfor.def
      subroutine dosub(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer ctoi,length,min
      integer ap,fc,k,nc

      include cmacro.ri

      if (j-i < 3)
          return
      if (j-i < 4)
          nc = MAXTOK
      else {
          k = argstk(i+4)
          nc = ctoi(evalst,k)           # number of characters
          }
      k = argstk(i+3)                   # origin
      ap = argstk(i+2)                  # target string
      fc = ap + ctoi(evalst,k) - 1      # first char of substring
      if ((fc >= ap) & (fc < ap+length(evalst(ap)))) { # subarrays
          k = fc + min(nc,length(evalst(fc))) - 1
          for ( ; k >= fc ; k = k -1)
              call putbak(evalst(k))
          }
      return
      end

WATCOM Fortran 77版は以下の通り。

c dosub.f -- select substring
      include ratfor.def
      subroutine dosub(argstk,i,j)
      integer i,j,argstk(ARGSIZE)
      integer ctoi,length,min
      integer ap,fc,k,nc

      include cmacro.fi

      if (j-i .lt. 3) then
          return
      end if
      if (j-i .lt. 4) then
          nc = MAXTOK
      else
          k = argstk(i+4)
          nc = ctoi(evalst,k)      ! number of characters
      end if
      k = argstk(i+3)              ! origin
      ap = argstk(i+2)             ! target string
      fc = ap + ctoi(evalst,k) - 1 ! first char of substring
      if ((fc .ge. ap) .and. (fc .lt. ap+length(evalst(ap)))) then ! subarrays
          k = fc + min(nc,length(evalst(fc))) - 1
          while (k .ge. fc) do
              call putbak(evalst(k))
              k = k - 1
          end while
      end if
      return
      end