?TACL ROUTINE
#FRAME
#PUSH src^fname      { The source file name.                                  }
#PUSH dest^fname     { The destination file name.                             }
#PUSH keep^no        { The number of copies to keep.                          }
#PUSH prefix         { The prefix for the backup file name.                   }
#PUSH suffix         { The suffix for the backup file name.                   }
#PUSH status         { The result of FUP, RENAME, and PURGE operations.       }
===============================================================================
#SET  prefix               F000
===============================================================================
[#DEF validate^keep^no MACRO |BODY|
      #SET suffix 99999999
      #SET suffix [#CHARGET suffix 1 FOR [#COMPUTE 8 - [#CHARCOUNT prefix]]]
      [#IF keep^no > [suffix]
        |THEN|
         #OUTPUT Keep number must be less than [#CHARCOUNT suffix] digits.
         #RETURN
      ]
      [#IF [keep^no] < 2
        |THEN|
          #OUTPUT Keep number must be at least 2.
          #RETURN
      ]
]
[#DEF set^dest MACRO |BODY|
      #SET suffix 00000000
      #SET suffix [#CHARGET suffix 1 FOR [#COMPUTE 7 - [#CHARCOUNT prefix]]]1
      #SET dest^fname [#FILEINFO/VOLUME/[src^fname]].&
{                    }[#FILEINFO/FILE/[src^fname]].[prefix][suffix]

]
[#DEF digits ROUTINE |BODY|
      #FRAME
      #PUSH num
      #PUSH num^prefix
      #SET num^prefix 00000000
      SINK [#ARGUMENT/VALUE num/NUMBER]
      #SET num [#CHARGET num^prefix 1 FOR &
       [#COMPUTE 8 - [#CHARCOUNT prefix] - [#CHARCOUNT num]]][num]
      #RESULT [num]
      #UNFRAME
]
[#DEF purgeit MACRO |BODY|
      #OUTPUT       PURGE [new^fname]
      #SET status [#PURGE [new^fname]]
      [#IF [status]
        |THEN|
          #OUTPUT Error [status] on PURGE of [new^fname].
          #RAISE _FAILURE
      ]
]
[#DEF renameit MACRO |BODY|
      #OUTPUT       RENAME [fname],[new^fname]
      #SET status [#RENAME [fname] [new^fname]]
      [#IF [status]
        |THEN|
          #OUTPUT Error [status] on RENAME of [fname] to [new^fname].
          #RAISE _FAILURE
      ]
]
[#DEF rollup ROUTINE |BODY|
      #FRAME
      #PUSH num
      #PUSH max
      #PUSH fname
      #PUSH new^fname

      SINK [#ARGUMENT/VALUE fname/FILENAME/SYNTAX/]
      SINK [#ARGUMENT/VALUE max/NUMBER]

      [#IF [#FILEINFO/EXISTENCE/[fname]]
         |THEN|
         |ELSE|
           { no file to roll! }
           #RESET FRAMES
           #RETURN
      ]

      { build new file name }
      #SET num [#FILEINFO/FILE/[fname]]
      #SET num [#CHARGET num [#COMPUTE [#CHARCOUNT prefix]+1] FOR 8]
      #SET num [digits [#COMPUTE [num]+1]]
      #SET new^fname &
        [#FILEINFO/VOLUME/[fname]].[#FILEINFO/SUBVOL/[fname]].[prefix][num]

      { If new file name exists, purge it and rename. }
      [#IF [#FILEINFO/EXISTENCE/[new^fname]]
        |THEN|
           [#IF [num] + 1 > [max]
             |THEN|
               purgeit
               renameit

             |ELSE|
                { Recursion }
                [#LOOP
                  |WHILE|
                    [#FILEINFO/EXISTENCE/[new^fname]]
                  |DO|
                    rollup [new^fname] [max]
                ]
           ]
        |ELSE|
          renameit
      ]
      #UNFRAME
]

[#DEF do^work MACRO |BODY|
      validate^keep^no
      set^dest
      rollup [dest^fname] [keep^no]
      [#LOOP
        |WHILE|
          [#FILEINFO/EXISTENCE/[dest^fname]]
        |DO|
          rollup [dest^fname] [keep^no]
      ]

      #OUTPUT       RENAME [src^fname],[dest^fname]
      #SET status [#RENAME [src^fname] [dest^fname]]
      [#IF [status]
        |THEN|
          #OUTPUT Error [status] on RENAME of [src^fname] to [dest^fname].
          #RAISE _FAILURE
      ]
]
[#DEF display^help MACRO |BODY|
      #SET suffix ########
      #SET suffix [#CHARGET suffix 1 FOR [#COMPUTE 8 - [#CHARCOUNT prefix]]]
      #OUTPUT
      #OUTPUT FILEROLL routine.  Expands to SUCCESS when successful.
      #OUTPUT
      #OUTPUT Renames the specified file, keeping the specified
      #OUTPUT number of previous versions.  The subvol of the BACKUP file will
      #OUTPUT be the filename and the filename will be [prefix][suffix],
      #OUTPUT where [suffix] is the sequence number.
      #OUTPUT
      #OUTPUT FORMAT:  #OUTPUT ~[FILEROL2 fname  keep#~]
      #OUTPUT EXAMPLE: #OUTPUT ~[FILEROL2 testfile  10~]
      #OUTPUT
]
[#DEF do^work^filter ROUTINE |BODY|
      #FILTER _ERROR _BREAK _FAILURE
      [#CASE [#EXCEPTION]
         |_CALL|      do^work
                      #RESULT SUCCESS
         |_FAILURE|   #RESULT Error.
                      #RESET FRAMES
                      #RETURN
         |_ERROR|     #OUTPUT Routine error!
                      #PUSH  error^text
                      #ERRORTEXT/CAPTURE error^text/
                      OUTVAR error^text
                      #POP   error^text
                      #RESULT Error.
                      #RESET FRAMES
                      #RETURN
         |_BREAK|     #OUTPUT <BREAK> detected.
                      #RESET FRAMES
                      #RETURN
         |OTHERWISE|  #OUTPUT Otherwise!!??
      ]
]
[#CASE [#ARGUMENT/VALUE src^fname/FILENAME END]
  |1| SINK [#ARGUMENT/VALUE keep^no/NUMBER]
      #RESULT [do^work^filter]
  |2| display^help
]
#UNFRAME