$say:=write sys$output
$say "Creating modtime.for"
$create modtime.for
$deck
        program modtime
        ! MODTIME Version 1.0 June 1st, 1985
        ! Written  by Joe Meadows Jr.,  with thanks  to the
        ! Fred Hutchinson Cancer Research Center for kindly
        ! allowing  me to  use  their  computing  resources.
        !
        ! If  you  have any  questions, comments, ideas, or
        ! whatever, feel free to contact me via US Mail :
        !       Joe Meadows Jr.
        !       4841 268th Ave. N.E.
        !       Redmond Wa. 98052
        ! or via phone : (206) 827-7296

        implicit integer (a-z)
        integer time(2)
        character buffer*80,file*252
        external lib$put_output

        call error(cli$get_value('File',file))
        if (cli$present('log')) routine=%loc(lib$put_output)
        if (cli$present('creation')) then
         call error(cli$get_value('creation',buffer))
         call error(sys$bintim(buffer,time))
         I=change_creation(file,time,routine)
        end if
        if (cli$present('revision')) then
         call error(cli$get_value('revision',buffer))
         call error(sys$bintim(buffer,time))
         I=change_revision(file,time,routine)
        end if
        if (cli$present('number')) then
         call error(cli$get_value('number',buffer))
         call str$trim(buffer,buffer,len)
         call error(ots$cvt_ti_l(buffer(:len),time))
         I=change_revnum(file,time,routine)
        end if
        if (cli$present('backup')) then
         call error(cli$get_value('backup',buffer))
         call error(sys$bintim(buffer,time))
         I=change_backup(file,time,routine)
        end if
        if (cli$present('expiration')) then
         call error(cli$get_value('expiration',buffer))
         call error(sys$bintim(buffer,time))
         I=change_expiration(file,time,routine)
        end if
        end
$eod
$say "Creating error.mar"
$create error.mar
$deck
        .title  error-exit
        .entry  error,0
        blbs    @4(ap),return
        $exit_s code=@4(ap)
return: ret
        .end
$eod
$say "Creating time.mar"
$create time.mar
$deck
        .TITLE Change_Times
;       Author  Joe Meadows
$FABDEF
$NAMDEF
FAB:    $FAB    NAM=NAM
NAM:    $NAM    ESA=ES,ESS=NAM$C_MAXRSS,RSA=RS,RSS=NAM$C_MAXRSS
DELFAB: $FAB    FNA=RS,FNS=NAM$C_MAXRSS
ES:     .BLKB   NAM$C_MAXRSS
RS:     .BLKB   NAM$C_MAXRSS
ESD:    .LONG   0,ES
RSD:    .LONG   0,RS
$IODEF
$ATRDEF
$FIBDEF
FIB:    .BLKB   FIB$K_LENGTH
FIBD:   .LONG   FIB$K_LENGTH,FIB
DEVNAM: .LONG   0,NAM+NAM$T_DVI+1
CHAN:   .WORD   0
ATR:    .LONG   0,buffer,0
buffer: .BLKB   35
;
FILENAME=4
TIME=8
ROUTINE=12
;
        .ENTRY  CHANGE_CREATION,^M<R6,R7>
        MOVW    #ATR$S_CREDATE,ATR
        MOVW    #ATR$C_CREDATE,ATR+2
        BRB     START
        .ENTRY  CHANGE_REVISION,^M<R6,R7>
        MOVW    #ATR$S_REVDATE,ATR
        MOVW    #ATR$C_REVDATE,ATR+2
        BRB     START
        .ENTRY  CHANGE_REVNUM,^M<R6,R7>
        MOVW    #ATR$S_ASCDATES,ATR
        MOVW    #ATR$C_ASCDATES,ATR+2
        BRB     START
        .ENTRY  CHANGE_BACKUP,^M<R6,R7>
        MOVW    #ATR$S_BAKDATE,ATR
        MOVW    #ATR$C_BAKDATE,ATR+2
        BRB     START
        .ENTRY  CHANGE_EXPIRATION,^M<R6,R7>
        MOVW    #ATR$S_EXPDATE,ATR
        MOVW    #ATR$C_EXPDATE,ATR+2

START:  MOVQ    @FILENAME(AP),R6
        MOVB    R6,FAB+FAB$B_FNS
        MOVL    R7,FAB+FAB$L_FNA
        MOVQ    @TIME(AP),buffer

        $PARSE  FAB=FAB
        JSB     ERROR
        MOVZBL  NAM+NAM$T_DVI,DEVNAM
        $ASSIGN_S-
                DEVNAM=DEVNAM,CHAN=CHAN
        JSB     ERROR

LOOP:   $SEARCH FAB=FAB
        CMPL    R0,#RMS$_PRV
        BEQL    LOOP
        JSB     ERROR
        MOVC3   #6,NAM+NAM$W_FID,FIB+FIB$W_FID
        CMPW    ATR+2,#ATR$C_ASCDATES
        BNEQ    CONT
        $QIO_S  CHAN=CHAN,FUNC=#IO$_ACCESS,P1=FIBD,P5=#ATR
        MOVC5   #0,buffer+15,#0,#<ATR$S_ASCDATES-15>,buffer+15
        MOVW    @TIME(AP),buffer
CONT:   $QIO_S  CHAN=CHAN,FUNC=#IO$_MODIFY,P1=FIBD,P5=#ATR
        JSB     ERROR
        TSTL    @ROUTINE(AP)
        BEQL    BLIP
        MOVZBL  NAM+NAM$B_RSL,RSD
        PUSHAL  RSD
        MOVL    @ROUTINE(AP),R6
        CALLS   #1,(R6)
BLIP:   BRW     LOOP

EXIT:   CMPL    R0,#RMS$_NMF
        BNEQ    BYE
        MOVL    #1,R0
BYE:    RET

ERROR:  BLBC    R0,EXIT
        RSB

        .END
$eod
$say "Creating modify.cld"
$create modify.cld
$deck
!************************************MODIFY*************************************
define verb MODIFY
   image EXE$DIR:MODTIME
   parameter P1 , label=FILE , prompt="File"
      value (required)
   qualifier CREATION
      value
   qualifier BACKUP
      value
   qualifier REVISION
      value
   qualifier NUMBER
      value
   qualifier EXPIRATION
      value
   qualifier LOG
$eod
$say "Compiling modtime.for"
$fortran modtime
$say "Compiling error.mar"
$macro error
$say "Compiling time.mar"
$macro time
$say "Linking modtime,error,time"
$link modtime,error,time
$say "Defining command MODIFY (modify.cld)"
$set command modify
$say "You need to define EXE$DIR to point to the where modtime is"
