.title fip_1 -- fip manipulation routines
      .library 'god$lib:'
      .library 'fip'
; entry pts.:
;     FIP$ALOFIP       ( fip )
;     FIP$FREFIP       ( fip )
;     FIP$INIFIP       ( fip )
;     FIP$MOVFIP       ( [src-fip], [dst-fip] )
;
;     FIP$GET_ES       ( [fip], [file], , , [ofile], [olen] )
;     FIP$GET_RS       ( [fip], [file], , , [ofile], [olen] )
;     FIP$GET_NAME     ( [fip], [file], , , [ofile], [olen] )
;
; jsb points:
;     FIP_ALOFIP
;     FIP_FREFIP
;     FIP_INIFIP
;     FIP_MOVFIP
;
;     FIP_GET_ES
;     FIP_GET_RS
;
;     FIP_ARGM_FIP
;     FIP_ARGM_FIP_FILE
;
; registers:
;     R2 = address of fip
;     R3 = argm mask
; def macros:
      $fipdef
; psect:
      $esect _fip$code
;=====================================================FIP MANIPULATORS
;-------------------------------------------------------------ALOFIP
;     status = fip$alofip( fip.ml.r )
;     the jsb pt. takes r2 (0) as arg, and returns addr of a new fip in it.
;
      .entry fip$alofip, ^m<r2,r3,r4,r5>
      movl    @fip$p_fip(ap), r2
      jsb     fip_alofip
      movl    r2, @fip$p_fip(ap)
      ret
;-----------
fip_alofip::
      tstl    r2
      bneq    10$
      clrq    -(sp)
      clrq    -(sp)
      pushaq  8(sp)
      ashl    #-9, #fip$k_bln, -(sp)
      incl    (sp)
      calls   #4, g^sys$expreg
      movl    (sp)+, r2
      clrl    (sp)+
      blbc    r0, 10$
      jsb     fip_inifip
10$:  rsb
;-------------------------------------------------------------FREFIP
;     status = fip$frefip( fip.ml.r )
;
      .entry fip$frefip, ^m<>
      movl    @fip$p_fip(ap), r2
      jsb     fip_frefip
      movl    r2, @fip$p_fip(ap)
      ret
;-----------
fip_frefip::
      tstl    r2
      beql    10$
      pushl   r2
      addl3   #fip$k_bln, r2, -(sp)
      clrq    -(sp)
      pushal  8(sp)
      calls   #3, g^sys$deltva
      clrq    (sp)+
      clrl    r2
      movl    #1, r0
10$:  rsb
;-------------------------------------------------------------INIFIP
;     status = fip$inifip( fip.ml.r )
;
      .entry fip$inifip, ^m<r2,r3,r4,r5>
      jsb     fip_argm_fip
      jsb     fip_inifip
      ret
;-----------
fip_inifip::
      pushr   #^m<r0,r1,r2,r3,r4,r5>
      movc5   #0, #0, #0, #fip$k_bln, (r2)
      popr    #^m<r0,r1,r2,r3,r4,r5>
                                                      ; bid/cod & bln
      movb    #fab$c_bid,    <fip$f_fab+fab$b_bid>(r2)
      movb    #fab$c_bln,    <fip$f_fab+fab$b_bln>(r2)
      movb    #nam$c_bid,    <fip$f_nam+fab$b_bid>(r2)
      movb    #nam$c_bln,    <fip$f_nam+fab$b_bln>(r2)
      movb    #xab$c_dat,    <fip$f_xabdat+xab$b_cod>(r2)
      movb    #xab$c_datlen, <fip$f_xabdat+xab$b_bln>(r2)
      movb    #xab$c_fhc,    <fip$f_xabfhc+xab$b_cod>(r2)
      movb    #xab$c_fhclen, <fip$f_xabfhc+xab$b_bln>(r2)
      movb    #xab$c_pro,    <fip$f_xabpro+xab$b_cod>(r2)
      movb    #xab$c_prolen, <fip$f_xabpro+xab$b_bln>(r2)
      movb    #xab$c_rdt,    <fip$f_xabrdt+xab$b_cod>(r2)
      movb    #xab$c_rdtlen, <fip$f_xabrdt+xab$b_bln>(r2)
                                                      ; misc const.
      movb    #fab$c_var,    <fip$f_fab+fab$b_rfm>(r2)
      movb    #nam$c_maxrss, <fip$f_nam+nam$b_rss>(r2)
      movb    #nam$c_maxrss, <fip$f_nam+nam$b_ess>(r2)
      movw    #^xffff,       <fip$f_xabpro+xab$w_pro>(r2)
                                                      ; fab pointers
      moval   fip$f_xabdat(r2), <fip$f_fab+fab$l_xab>(r2)
      moval   fip$f_nam(r2),    <fip$f_fab+fab$l_nam>(r2)
      moval   fip$f_rsa(r2),    <fip$f_nam+nam$l_rsa>(r2)
      moval   fip$f_esa(r2),    <fip$f_nam+nam$l_esa>(r2)
                                                      ; xab Next's
      moval   fip$f_xabfhc(r2), <fip$f_xabdat+xab$l_nxt>(r2)
      moval   fip$f_xabpro(r2), <fip$f_xabfhc+xab$l_nxt>(r2)
      moval   fip$f_xabrdt(r2), <fip$f_xabpro+xab$l_nxt>(r2)

      movl    #1, fip$f_status(r2)
      movl    #1, r0
      rsb
;-----------------------------------------------------MOVFIP
;     status = fip$movfip( [src-fip], [dst-fip] )
;     to copy fip from one location to another.  addrs default to fip0.
;
      .entry fip$movfip, ^m<r2,r3,r4,r5>
      $check_fip arg=<1>, reg=<r1>, err=10$
      $check_fip arg=<2>, reg=<r2>, err=10$
      movc3   #fip$k_bln, (r1), (r2)
      movl    #1, r0
10$:  ret
;=====================================================GET NAME ROUTINES
      .entry fip$get_rs, ^m<r2,r3,r4,r5>
      jsb     fip_argm_fip_file
      jsb     fip_get_rs
      movl    fip$f_status(r2), r0
      ret
;---------------
fip_get_rs::
      $prepare_file <search>
      bbc     #fip$a_olen, r3, 10$            ; return length?
      movzbw  fip$b_rsl(r2), @fip$p_olen(ap)
10$:  bbc     #fip$a_ofile, r3, 20$
      pushr   #^m<r0,r1,r2,r3,r4,r5>
      movaq   @fip$p_ofile(ap), r0            ; r0 = addr of arg
      movzbw  fip$b_rsl(r2), r1               ; r1 = len of rs
      movc5   r1, @fip$l_rsa(r2), #^a/ /, (r0), @4(r0)
      popr    #^m<r0,r1,r2,r3,r4,r5>
20$:  rsb
;---------------------------------------------------------------------------
      .entry fip$get_es, ^m<r2,r3,r4,r5>
      jsb     fip_argm_fip_file
      jsb     fip_get_es
      movl    fip$f_status(r2), r0
      ret
;---------------
fip_get_es::
      $prepare_file <parse>
      bbc     #fip$a_olen, r3, 10$            ; return length?
      movzbw  fip$b_esl(r2), @fip$p_olen(ap)
10$:  bbc     #fip$a_ofile, r3, 20$
      pushr   #^m<r0,r1,r2,r3,r4,r5>
      movaq   @fip$p_ofile(ap), r0            ; r0 = addr of arg
      movzbw  fip$b_esl(r2), r1               ; r1 = len of rs
      movc5   r1, @fip$l_esa(r2), #^a/ /, (r0), @4(r0)
      popr    #^m<r0,r1,r2,r3,r4,r5>
20$:  rsb
;---------------------------------------------------------------------------
      .entry fip$get_name, ^m<r2,r3,r4,r5,r6>
      jsb     fip_argm_fip_file
      $prepare_file <search>
      jsb     fip_get_name
      movl    fip$f_status(r2), r0
      ret
;-------------
fip_get_name::
      bbc     #fip$v_search, fip$f_flags(r2), 10$
      jsb     fip_get_rs
      blbs    r0, 20$
10$:  jsb     fip_get_es
20$:  rsb
;=============================================JSB ROUTINES============
fip_argm_fip::
      $get_argm
      $check_fip
      rsb
fip_argm_fip_file::
      $get_argm
      $check_fip
      $check_file
      rsb
;=====================================================================
      .end