.title SetDate - Set File's Date & Time .ident /SETD 1.1 DNorth/ ; .library /mar:always/ .library /sys$library:lib/ ; ; Program: SETDATE.MAR V1.1 ; ; Author: David G. North, CCP ; 1333 Maywood Ct ; Plano, Texas 75023-1914 ; (214) 902-3957 ; ; Date: 90.11.16 ; ; Revisions: ; Who Date Description ; D.North 901116 DECUS release (Fall 90) ; D.North 911113 DECUS release (Fall 91) ; ; License: ; Ownership of and rights to these programs is retained by the author(s). ; Limited license to use and distribute the software in this library is ; hereby granted under the following conditions: ; 1. Any and all authorship, ownership, copyright or licensing ; information is preserved within any source copies at all times. ; 2. Under absolutely *NO* circumstances may any of this code be used ; in any form for commercial profit without a written licensing ; agreement from the author(s). This does not imply that such ; a written agreement could not be obtained. ; 3. Except by written agreement under condition 2, source shall ; be freely provided with all binaries. ; 4. Library contents may be transferred or copied in any form so ; long as conditions 1, 2, and 3 are met. Nominal charges may ; be assessed for media and transferral labor without such charges ; being considered 'commercial profit' thereby violating condition 2. ; ; Warranty: ; These programs are distributed in the hopes that they will be useful, but ; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY ; or FITNESS FOR A PARTICULAR PURPOSE. ; $ssdef $rmsdef $iodef $atrdef $fibdef CLI$_SYNTAX = ^x310fc ; I couldn't find this anywhere! .psect setdate$$data proto: $fab ;alloc space $nam ;for proto storage eproto: sfab: $fab dnm = <*.*;>,- nam = snam snam: $nam rss = 255,- rsa = resul,- ess = 255,- esa = expan resul: .blkb 256 expan: .blkb 256 msgvec: .blkl 16 thefab: $fab fac = ,- fop = ;user file open dscfib: .long ^x010e0010 .address thefib thefib: .blkl 16 dskchn: .long dskstb: .quad atrlst: .word 8,ATR$C_CREDATE .address qcreio .word 8,ATR$C_EXPDATE .address qexpio .word 8,ATR$C_BAKDATE .address qbacio .word 8,ATR$C_REVDATE .address qrevio .long 0 dlog: .ascid /LOG/ drst: .ascid /RESET/ dhelp: .ascid /HELP/ minhlp: .ascid ~?Usage: SETDATE file[/reset|/touch][/log]~ maxhlp: .ascid ~?Usage: SETDATE file[/[no]{all|exp|bac|cre|rev}=date][/reset|/touch][/log]~ dexp: .ascid /EXPIRATION_DATE/ dcre: .ascid /CREATION_DATE/ drev: .ascid /REVISION_DATE/ dbac: .ascid /BACKUP_DATE/ dall: .ascid /ALL_DATES/ dtou: .ascid /TOUCH/ texp: .udesc tcre: .udesc trev: .udesc tbac: .udesc tall: .udesc ttou: .word trst: .word tlog: .word qexp: .quad qcre: .quad qrev: .quad qbac: .quad qall: .quad qnow: .quad qexpio: .quad qcreio: .quad qrevio: .quad qbacio: .quad dfilnm: .ascid /FILENAME/ ;label for P1 filbuf: .udesc ;place for item value .psect setdate$$code suc: .word ^m movl 4(ap),r2 movl fab$l_nam(r2),r0 movl nam$l_rsa(r0),r1 movzbl nam$b_rsl(r0),r0 bisl #^x010e0000,r0 movq r0,-(sp) pushaq (sp) calls #1,@fab$l_ctx(r2) blbc r0,99$ tstw tlog beql 99$ moval msgvec,r1 movl #3,(r1)+ movl #std_datemod,(r1)+ movl #1,(r1)+ movaq (sp),(r1)+ $putmsg_s - msgvec = msgvec 99$: ret err: .word ^m movl 4(ap),r2 movl fab$l_nam(r2),r0 movl nam$l_rsa(r0),r1 movzbl nam$b_rsl(r0),r0 bisl #^x010e0000,r0 movq r0,-(sp) moval msgvec,r1 movl #5,(r1)+ movl #std_erraccfil,(r1)+ movl #1,(r1)+ movaq (sp),(r1)+ movl fab$l_sts(r2),(r1)+ movl fab$l_stv(r2),(r1)+ $putmsg_s - msgvec = msgvec ret filact: .word ^m movc3 #eproto-proto,sfab,proto clrl -(SP) ;set up context movq @4(AP),r0 ;get descriptor to rq0 movb r0,sfab+fab$b_fns movab (r1),sfab+fab$l_fna movl 8(AP),sfab+fab$l_ctx ;user routine 10$: pushal (SP) ;context! pushaw err pushaw suc pushab sfab calls #4,G^LIB$FILE_SCAN bbc #NAM$V_WILDCARD,snam+nam$l_fnb,20$ ;no wildcard cmpl r0,#RMS$_FNF beql 20$ cmpl r0,#RMS$_NMF beql 20$ blbs r0,10$ brb barf 20$: pushal (SP) pushab sfab calls #2,G^LIB$FILE_SCAN_END movc3 #eproto-proto,proto,sfab ;restore proto movl #SS$_NORMAL,r0 barf: ret errex: $exit_s - code = r0 erret: movab thefab,r2 pushl fab$l_fna(r2) movzbl fab$b_fns(r2),-(sp) bisl #^x010e0000,(sp) moval msgvec,r1 movl #5,(r1)+ movl #std_errsetdate,(r1)+ movl #1,(r1)+ movaq (sp),(r1)+ movl fab$l_sts(r2),(r1)+ movl fab$l_stv(r2),(r1)+ movl r0,r2 $putmsg_s - msgvec = msgvec movc3 #eproto-proto,proto,sfab ;restore proto movl r2,r0 ret clitrp: .word ^m<> ret ;ignore error getitm: .word ^m<> movaw clitrp,(FP) ;set up exception handler for CLI pushaq @4(AP) calls #1,G^CLI$PRESENT cmpl #CLI$_PRESENT,r0 beql 10$ cmpl #CLI$_NEGATED,r0 beql 20$ cmpl #CLI$_ABSENT,r0 beql 30$ cmpl #CLI$_SYNTAX,r0 beql 30$ blbcw r0,errex bicl #1,r0 brw errex 10$: cmpl 0(AP),#3 ;was output asked for? blssu 15$ ;nope pushaw @8(AP) pushaq @8(AP) pushaq @4(AP) calls #3,G^CLI$GET_VALUE blbcw r0,errex $bintim_s - timbuf = @8(AP),- timadr = @12(AP) blbcw r0,errex 15$: movw #1,@8(AP) ;put presence flag brw 99$ 20$: clrl @12(AP) ;put a zero at output movw #1,@8(AP) ;put presence flag brw 99$ 30$: clrw @8(AP) ;zap text area length brw 99$ 99$: ret fixupd: .word ^m movc5 #0,#0,#0,#64,thefib ;initialize FIB movl #FIB$M_WRITE!FIB$M_NORECORD,thefib+FIB$L_ACCTL movl 4(AP),r0 movb (r0),thefab+fab$b_fns movab @4(r0),thefab+fab$l_fna $open - fab = thefab blbcw r0,erret movl thefab+fab$l_stv,dskchn $qiow_s - chan = dskchn,- func = #IO$_ACCESS,- iosb = dskstb,- p1 = dscfib,- p5 = #atrlst blbcw r0,erret movzwl dskstb,r0 blbcw r0,erret 100$: tstw tall ;see if all spec'd beql 110$ movq qall,qcreio movq qall,qrevio movq qall,qexpio movq qall,qbacio ;set all brw 150$ 110$: tstw texp beql 120$ movq qexp,qexpio 120$: tstw tcre beql 130$ movq qcre,qcreio 130$: tstw ttou beql 135$ movq qnow,qrevio 135$: tstw trev beql 140$ movq qrev,qrevio 140$: tstw trst beql 145$ movq qcreio,qrevio clrq qbacio 145$: tstw tbac beql 150$ movq qbac,qbacio 150$: $qiow_s - chan = dskchn,- func = #IO$_DEACCESS,- iosb = dskstb,- p1 = dscfib,- p5 = #atrlst blbcw r0,erret movzwl dskstb,r0 blbcw r0,erret $dassgn_s - chan = dskchn blbcw r0,erret ret startg: .word ^m pushaq dhelp calls #1,G^CLI$PRESENT cmpl #CLI$_DEFAULTED,r0 bneq nohelp movaw clitrp,(FP) ;set up CLI exception handler pushaq dexp calls #1,G^CLI$PRESENT movab minhlp,r1 cmpl #CLI$_SYNTAX,r0 beql 10$ movab maxhlp,r1 10$: pushaq (r1) calls #1,G^LIB$PUT_OUTPUT ret nohelp: pushaq qall pushaq tall pushaq dall calls #3,getitm pushaq qexp pushaq texp pushaq dexp calls #3,getitm pushaq qcre pushaq tcre pushaq dcre calls #3,getitm pushaq qrev pushaq trev pushaq drev calls #3,getitm pushaq qbac pushaq tbac pushaq dbac calls #3,getitm pushaq trst pushaq drst calls #2,getitm pushaq ttou pushaq dtou calls #2,getitm pushaq tlog pushaq dlog calls #2,getitm movzwl tall,r0 bisw tcre,r0 bisw trev,r0 bisw texp,r0 bisw tbac,r0 bisw ttou,r0 bisw trst,r0 bneq 10$ moval msgvec,r1 movl #1,(r1)+ movl #std_nowork,(r1)+ ;no work to do! $putmsg_s - msgvec = msgvec brw 20$ 10$: $gettim_s - timadr = qnow 15$: movw filbuf,r2 pushaw filbuf pushaq filbuf pushaq dfilnm calls #3,G^CLI$GET_VALUE blbcw r0,errex movl r0,r3 pushaw fixupd pushaq filbuf calls #2,G^filact movw r2,filbuf ;restore buffer length cmpl r3,#CLI$_COMMA ;test for list processing beql 15$ cmpl r3,#CLI$_CONCAT beql 15$ 20$: ret .End startg