.title  fip_4 -- to get/set fip info
      .library 'god$lib:'
      .library 'fip'

;  GET READONLY INFO
;     fip$get_uic ( [fip], [file], [old],      , [file-o], [len-o] )
;     fip$get_fid ( [fip], [file], [old],      , [file-o], [len-o] )
;     fip$get_did ( [fip], [file], [old],      , [file-o], [len-o] )
;     fip$get_date( [fip], [file], [old],      , [file-o], [len-o] )
;     fip$get_rvn ( [fip], [file], [old],      , [file-o], [len-o] )
;     fip$get_rdt ( [fip], [file], [old],      , [file-o], [len-o] )
;     fip$get_siz ( [fip], [file], [old],      , [file-o], [len-o] )
;     fip$get_alq ( [fip], [file], [old],      , [file-o], [len-o] )
;
;  GET/SET INFO
;     fip$set_prot( [fip], [file], [old], [new], [file-o], [len-o] )
;
;  MISC INFO
;     fip$wildcard( [fip], [file],      ,      , [file-o], [len-o] )

; definition macros
      $fipdef
; psect:
      $esect _fip$code
;===========================================================================
;---------------------------------------------------------------------------
      .entry fip$get_fid, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 10$
      $prepare_file <display>, err=10$
      moval   fip$w_fid(r2),  r0
      moval   @fip$p_old(ap), r1
      movl    (r0)+, (r1)+
      movw    (r0),  (r1)
10$:  jsb     fip_get_name
;;    movl    fip$f_status(r2), r0
      ret
;---------------------------------------------------------------------------
      .entry fip$get_did, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 10$
      $prepare_file <display>, err=10$
      moval   fip$w_did(r2),  r0
      moval   @fip$p_old(ap), r1
      movl    (r0)+, (r1)+
      movw    (r0),  (r1)
10$:  jsb     fip_get_name
;     movl    fip$f_status(r2), r0
      ret
;---------------------------------------------------------------------------
      .entry fip$get_size, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 10$
      $prepare_file <display>, err=10$
      movl    fip$l_ebk(r2), @fip$p_old(ap)   ; get old value
      tstw    fip$w_ffb(r2)
      bnequ   10$                     ; if ffb=0 then decrement size
      decl    @fip$p_old(ap)
10$:  jsb     fip_get_name
;     movl    fip$f_status(r2), r0
      ret
;---------------------------------------------------------------------------
      .entry fip$get_alq, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 10$
      $prepare_file <display>, err=10$
      movl    fip$l_alq(r2), @fip$p_old(ap)
10$:  jsb     fip_get_name
;     movl    fip$f_status(r2), r0
      ret
;---------------------------------------------------------------------------
fip$get_date::
      .entry fip$get_cdt, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 10$
      $prepare_file <display>, err=10$
      movq    fip$q_cdt(r2), @fip$p_old(ap)
10$:  jsb     fip_get_name
;     movl    fip$f_status(r2), r0
      ret
;=====================================================GET/SET ROUTINES=========
      .entry fip$get_prot, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 20$

      bbc     #fip$a_old, r3, 10$
      $prepare_file <display>, err=20$
      movw    fip$w_pro(r2), @fip$p_old(ap)           ; get old info

10$:  bbc     #fip$a_new, r3, 20$
      pushl   fip$f_flags(r2)
      $prepare_file <open_w>, err=20$                 ; set new info
      movw    @fip$p_new(ap), fip$w_pro(r2)
      bbs     #fip$v_open_w, (sp), 20$                ; if not already open_w..
      jsb     fip_close                              ; ...then close it
20$:  jsb     fip_get_name
;     movl    fip$f_status(r2), r0
      ret
;--------------------------------------------------------------------------
      .entry fip$get_uic, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 20$

      bbc     #fip$a_old, r3, 10$
      $prepare_file <display>, err=<20$>              ; get old info only
      movl    fip$l_uic(r2), @fip$p_old(ap)

10$:  bbc     #fip$a_new, r3, 20$
      pushl   fip$f_flags(r2)
      $prepare_file <open_w>, err=<20$>
      movl    @fip$p_new(ap), fip$l_uic(r2)
      bbs     #fip$v_open_w, (sp), 20$
      jsb     fip_close
20$:  jsb     fip_get_name
 ;    movl    fip$f_status(r2), r0
      ret
;---------------------------------------------------------------------------
      .entry fip$get_rdt, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 20$

      bbc     #fip$a_old, r3, 10$
      $prepare_file <display>, err=<20$>
      movq    fip$q_rdt(r2), @fip$p_old(ap)           ; get old info

10$:  bbc     #fip$a_new, r3, 20$
      cmpb    (ap), #7
      bneq    20$
      pushl   fip$f_flags(r2)
      $prepare_file <open_w>, err=20$                 ; set new info
      movq    @fip$p_new(ap), fip$q_rdt(r2)
      bbs     #fip$v_open_w, (sp), 20$
      jsb     fip_close
20$:  jsb     fip_get_name                        ; just here & now
;     movl    fip$f_status(r2), r0
      ret
;---------------------------------------------------------------------------
      .entry fip$get_rvn, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 20$

      bbc     #fip$a_old, r3, 10$
      $prepare_file <display>, err=10$
      movw    fip$w_rvn(r2), @fip$p_old(ap)           ; get old info

10$:  bbc     #fip$a_new, r3, 20$
      cmpb    (ap), #7                                ; set new info
      bneq    20$
      pushl   fip$f_flags(r2)
      $prepare_file <open_w>, err=20$
      movw    @fip$p_new(ap), fip$w_rvn(r2)
      bbs     #fip$v_open_w, (sp), 20$
      jsb     fip_close
20$:  jsb     fip_get_name
;     movl    fip$f_status(r2), r0
      ret
;=====================================================MISC INFO=============
      .entry fip$wildcard, ^m<r2,r3>
      jsb     fip_argm_fip_file
      blbc    r0, 20$
      $prepare_file <parse>, err=30$
      bbs     #nam$v_wildcard, fip$l_fnb(r2), 10$     ; test for wildcard
      tstl    fip$l_fla(r2)                           ; if there is Flist...
      beql    20$
      locc    #^a/,/, fip$l_fls(r2), @fip$l_fla(r2)   ; ...then test for commas
      beql    20$
10$:                                                  ; Yes
      movl    #1, r0
      brb     30$
20$:                                                  ; No
      clrl    r0
30$:                                                  ; egress
      jsb     fip_get_name
      ret
;===========================================================================
      .end