$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 MOVW #ATR$S_CREDATE,ATR MOVW #ATR$C_CREDATE,ATR+2 BRB START .ENTRY CHANGE_REVISION,^M MOVW #ATR$S_REVDATE,ATR MOVW #ATR$C_REVDATE,ATR+2 BRB START .ENTRY CHANGE_REVNUM,^M MOVW #ATR$S_ASCDATES,ATR MOVW #ATR$C_ASCDATES,ATR+2 BRB START .ENTRY CHANGE_BACKUP,^M MOVW #ATR$S_BAKDATE,ATR MOVW #ATR$C_BAKDATE,ATR+2 BRB START .ENTRY CHANGE_EXPIRATION,^M 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,#,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"