.title          d_date
fab1:          $fab    ctx=1,fop=<cbt,tef>,-
                    rat=cr,xab=xab1
rab1:          $rab    ctx=1,fab=fab1,rop=<asy>
xab1:          $xabdat
;
;
;        CALL D_DATE(filename,qdate)
;          where  filename is the filename in either CHARACTER form or
;                 null terminated BYTE string,
;                 and qdate is the address of a quadword to be set to
;                 the revision/creation date of the file.
d_date::          .word   ^m<r2,r3>
         cmpw    0(ap),#2        ;are there 2 args ?
         beql    name            ;YES. Good, that's only legal choice 
         jmp     badarg                  ;error
name:
         movl    4(ap),r0       ; get addr of descriptor 
         movl    r0,r3
         cmpb    2(r0),#14       ;is it a character string ?
         beql    char            ;yes. Descriptors always have 14 in high word
         movl    r0,r1           ;not CHAR, must be BYTE w/ null at end 
cloop:
         tstb    (r1)+           ;look for terminating null
         bneq    cloop           ;not yet found
         decl    r1              ;found null. point to last good char 
         subl    r0,r1           ;get string length
         $fab_store      fab=fab1,fns=r1,fna=(r3)
         brb     done
char:
         movzbl  (r3),r1       ;get string length
         movl    4(r3),r0      ;get string address
         decl    r0            ;r1 is 1 too big
chloop:                          ;get rid of trailing blanks
         addl2   r1,r0       ;get last char of string
         cmpb    (r0),#^a/ /    ;is it a blank ?
         bneq    cdon            ;no. stop looking for more blanks
         subl2   r1,r0       ;fix up address for next time
         sobgtr  r1,chloop     ;decrement length
cdon:
         $fab_store      fab=fab1,fns=r1,fna=@4(r3)
done:
read:                    ; open an existing file to read date
         clrq     xab$q_rdt + xab1
         clrq     xab$q_cdt + xab1
         movq     #0,@8(ap)         ;pre-clear result to zero
;        $fab_store      fab=fab1,fac=<get>
         .list meb
         $fab_store       fab=fab1,shr=<upi>
         .list
         $open   fab=fab1,err=error
         blbs    fab$l_sts + fab1,goon
         ret
goon:
;        pushal    fab1
;        calls #1,error
         movq     xab$q_rdt + xab1,@8(ap)
         bneq  close
norev:   movq     xab$q_cdt + xab1,@8(ap)
close:  
         $close          fab=fab1,err=error
         ret
;
;
error:
         .word 0
         moval    @4(ap),r0         ;happily error is called by an AST 
         pushal   rab$l_sts(r0)  ;with the control block as parameter.
;        cmpl    #rms$_eof,@(sp) ;assume that rab$l_sts and fab$l_sts 
;        beql    okay            ;will always coincide. 
         cmpl    #rms$_fnf,@(sp)
         beql    okay
do_mes:  calls #1,errmes         ;dump error message. 
okay:    ret
;
badarg:
         pushal   invarg
         calls    #1,errmes
         ret
invarg:  .long    mth$_wronumarg
;
         .end