アナクロなコンピューターエンジニアのつぶやき

detab,entabを拡張します。引数でタブ位置の情報を渡せるようにします。

     detab 1 5 10 15 20
     entab 2 6 11 18 30

さらに、

     detab 1 +5
     entab 5 +6

はじめのは、タブ位置をそのまま引数で渡します。次のは、最初の引数を元に、次の引数で、インクリメンタルにタブ位置を計算します。

最初の版settab2.forを示します。

c settab2.for -- set initial tab stops
      subroutine settab(tabs)
      integer tabs(81)                  ! MAXLINE(81)
      integer*1 argv(81)                ! MAXLINE(81)
      integer argc,junk,t,tpos
      integer ctoi,getarg,mod

      do 10 tpos=1,81
          tabs(tpos) = 0                ! NO(0)
   10     continue
   
      if (getarg(1,argv,81) .eq. -1) then ! MAXLINE(81) EOF(-1)
          tpos = 1
          while (tpos .le. 81) do       ! MAXLINE(81)
              if (mod(i,8) .eq. 1) then
                  tabs(i) = 1           ! YES(1)
              endif
              tpos = tpos + 1
          end while
      else
          junk = 1
          tpos = ctoi(argv,junk)
          if ((tpos .gt. 0) .and. (tpos .le. 81)) then
              tabs(tpos) = 1            ! YES(1)
          end if
          if (getarg(2,argv,81) .ne. -1) then ! MAXLINE(81)
              if (argv(1) .eq. 43) then ! PLUS(43)
                  junk = 1
                  t = ctoi(argv,junk)
                  while (tpos .le. 81) do
                      tabs(tpos) = 1    ! YES(1)
                      tpos = tpos + t
                  end while
              else
                  junk = 1
                  tpos = ctoi(argv,junk)
                  if ((tpos .gt. 0) .and. (tpos .le. 81)) then
                      tabs(tpos) = 1    ! YES(1)
                  end if
                  argc = 3
                  while (getarg(argc,argv,81) .ne. -1) do ! MAXLINE(81) EOF(-1)
                      junk = 1
                      tpos = ctoi(argv,junk)
                      if ((tpos .gt. 0) .and. (tpos .le. 81)) then ! MAXLINE(81)
                          tabs(tpos) = 1 ! YES(1)
                      end if
                      argc = argc + 1
                  end while
              end if
          else
              tabs(tpos) = 1            ! YES(1)
          endif
      end if
      return
      end

見通しが悪く、長ったらしくなってしまいました。

ここで、下請けルーチン、インクリメンタル型の引数を確認するtabincr(),タブ位置が範囲に入っているかを調べるtabbound()を導入します。

tabincr()は以下の通り。

c tabincr.for -- return YES if incrimentsl tab set
      integer function tabincr()
      integer*1 argv(81)                ! MAXLINE(81)
      integer getarg

      if (getarg(2,argv,81) .eq. -1) then ! MAXLINE(81) EOF(-1)
          tabincr = 0                   ! NO(0)
      else
          if (argv(1) .eq. 43) then     ! PLUS(43)
              tabincr = 1               ! YES(1)
          else
              tabincr = 0               ! NO(0)
          end if
      end if
      return
      end

tabbound()は以下の通り。

c tabbound -- check tab position boundary
      integer function tabbound(tab,tabmin,tabmax)
      integer tab,tabmin,tabmax

      if ((tabmin .ge. tab) .and. (tab .le. tabmax)) then
          tabbound = 1                  ! YES(1)
      else
          tabbound = 0                  ! NO(0)
      end if
      return
      end

これらを使ったsettab()は以下の通り。

c settab3.for -- set initial tab stops
      subroutine settab(tabs)
      integer tabs(81)                  ! MAXLINE(81)
      integer*1 argv(81)                ! MAXLINE(81)
      integer argc,junk,tincr,tpos
      integer ctoi,getarg,mod,tabincr

      do 10 tpos=1,81
          tabs(tpos) = 0                ! NO(0)
   10     continue
   
      if (getarg(1,argv,81) .eq. -1) then ! MAXLINE(81) EOF(-1)
          tpos = 1
          while (tpos .le. 81) do       ! MAXLINE(81)
              if (mod(tpos,8) .eq. 1) then
                  tabs(tpos) = 1        ! YES(1)
              endif
              tpos = tpos + 1
          end while
      else
          junk = 1
          tpos = ctoi(argv,junk)
          if (tabbound(tpos,1,81) .eq. 1) then ! YES(1)
              if (tabincr() .eq. 1) then ! YES(1)
                  tabs(tpos) = 1        ! YES(1)
                  junk = getarg(2,argv,81) ! MAXLINE(81)
                  junk = 1
                  tincr = ctoi(argv,junk)
                  tpos = tpos + tincr
                  while (tpos .le. 81) do ! MAXLINE(81)
                      tabs(tpos) = 1    ! YES(1)
                      tpos = tpos + tincr
                  end while
              else
                  argc = 2
                  while (getarg(argc,argv,81) .ne. -1) do ! MAXLINE(81) EOF(-1)
                      junk = 1
                      tpos = ctoi(argv,junk)
                      if (tabbound(tpos,1,81) .eq. 1) then ! MAXLINE(1) YES(1)
                          tabs(tpos) = 1 ! YES(1)
                      end if
                      argc = argc + 1
                  end while
              end if
          end if
      end if
      return
      end

多少は見通しが良くなったでしょうか。

暗号化、複合化プログラムcryptです。

入力文字と暗号化キーのXORをとることで暗号化しています。複合も同じです。

XORをとるには、組み込みのieorがありますが、ここでは、自作しました。

cryptのratfor版は下記の通り。

# crypt.r4 -- encrypt and decrypt
      character getc,xor
      character c,key(MAXKEY)
      integer getarg
      integer mod,i,keylen

      keylen = getarg(1,key,MAXKEY)
      if (keylen == EOF)
          call error('usage: crypt key.')
      for (i = 1; getc(c) != EOF; i = mode(i,keylen) + 1)
          call putc(xor(c,key(i)))
      stop
      end

とても単純ですね。Watcom Fortran 77版は下記の通り。

c crypt.for -- encrypt and decrypt
      program crypt
      integer*1 getc
      integer*1 c,key(11)               ! MAXKEY(11)
      integer getarg,ieor
      integer i,keylen

      keylen = getarg(1,key,11)         ! MAXKEY(11)
      if (keylen .eq. -1) then          ! EOF(-1)
          call error('usage: crypt key.')
      end if
      i = 1
      while (getc(c) .ne. -1) do        ! EOF(-1)
          call putc(xor(c,key(i)))
          i = mod(i,keylen) + 1
      end while
      stop
      end

xor()は、以下の通り。下請けルーチンbin2bit()は、integer*1の正の数を８ビットに分割します。bit2bin()は、８ビットに分割された数をinteger*1の数に戻します。いずれのルーチンも、負の数には対応できません。

c xor.for -- bit width xor
      integer*1 function xor(bin1,bin2)
      integer*1 bin1, bin2
      integer*1 bit2bin
      integer bit1(8),bit2(8),bit3(8),i

      call bin2bit(bin1,bit1)
      call bin2bit(bin2,bit2)
      do 10 i=1,8
          if (((bit1(i) .eq. 1) .and. (bit2(i) .eq. 0)) .or.
     1        ((bit1(i) .eq. 0) .and. (bit2(i) .eq. 1))) then
              bit3(i) = 1
          else
              bit3(i) = 0
          endif
   10 continue
      xor = bit2bin(bit3)
      return
      end

bin2bit()は、以下の通り。

c bin2bit.for -- convert bin to bit(i)
      subroutine bin2bit(bin8,bit)
      integer*1 bin8
      integer bit(8)
      integer abs,mod
      integer i,b

      b = bin8
      do 10 i=1,8
          bit(i) = abs(mod(b,2))
          b = b / 2
   10 continue
      return
      end

bit2bin()は、以下の通り。

c bit2bin.for -- convert bit(8) to bin
      integer*1 function bit2bin(bit)
      integer bit(8)

      bit2bin = bit(8)*128 + bit(7)*64 + bit(6)*32 + bit(5)*16
     1     + bit(4)*8 + bit(3)*4 + bit(2)*2 + bit(1)
      return
      end

実は、大きな落とし穴がありました。暗号化した文字が26、すなわち、0x1aになることがあります。 0x1aは、Windowsでは、テキストファイルの終わりのマークです。暗号化したファイルを読み込むと、0x1aのところで、 切れてしまいます。仕様なので、これ以上の事は追求しないことにしました。