🚀 go-pugleaf

The other day I posted a routine to fix the file header of a file with
the file characteristic bit ALM_AIP set.  The original posting is fine
for standalone VAX systems;  however, VAXcluster members may still ex-
perience problems accessing the file due to the fact that their caches
have not been flushed.

I uncovered this accidentally when playing on my uV2K cluster to which
I recently attached a RX23-AA.  At the time I thought it a bit useless
since the 3.5 floppy can hold very little data (~2500 blocks);  however,
it's a great commodity when you need to play with code that is modifying
file and/or volume data.  I highly recommend to anyone working on such
code to get themselves a floppy for their system.

BJS-

Anyway.... Here's the revised code...


        .title  CLEAR_ALM_AIP   (**example compliments of BJS**)

        .library        "sys$library:lib.mlb"
        .link           "sys$system:sys.stb"

        $ccbdef         ; channel control block definitions
        $fchdef         ; file characteristics definitions
        $fh2def         ; ODS2 file header definitions
        $fibdef         ; file info. block definitions
        $wcbdef         ; window control block definitions
;----------------------------------------------------------------------------
        .macro  check_status,status_block,?lbl1,?lbl2
        blbs    r0,lbl1
        ret
lbl1:
        .if nb  status_block
        movzwl  status_block,r0
        blbs    r0,lbl2
        ret
lbl2:
        .endc
        .endm   check_status
;------------------------------------------------------------------------------
        .psect  $$$data,wrt,noexe,page

get_channel:    $assign devnam=sys_disk,chan=xqp_function+qio$_chan
xqp_function:   $qio    func=io$_access!io$m_access,iosb=iosb,p1=fib_descr

fib_descr:      .long           fib$k_length
                .address        .+4

fib:            .blkb           fib$k_length
                .=fib+fib$w_fid_num             ;INDEXF.SYS
                .word   1                       ;FID=(1,1,0) - Always!!!
                .=fib+fib$w_fid_seq
                .word   1
                .=fib+fib$b_fid_rvn
                .byte   0
                .=fib+fib$b_fid_nmx
                .byte   0
                .=fib+fib$w_did_num             ;DID=(4,4,0) - Always!!!
                .word   4
                .=fib+fib$w_did_seq
                .word   4
                .=fib+fib$b_did_rvn
                .byte   0
                .=fib+fib$b_did_nmx
                .byte   0
                .=fib+fib$w_cntrlfunc           ; specify REMAP to get all of
                .word           fib$c_remap     ; the file's mapping pointers
                .=fib+fib$w_nmctl
                .word           fib$m_findfid
                .=fib+fib$k_length

iosb:   .quad   0
sys_disk:       .ascid          /CALVIN$DUA2:/  ;<<<*** you supply the drive

arglst:
arglst.argcnt:  .long   3
arglst.channel: .long   0
arglst.vbn:     .long   16      ;<<<*** VBN of your file's file header in
arglst.lbn:     .long   0       ;       INDEXF.SYS...

;----------------------------------------------------------------------------
        .align  page
block:  .blkb   512
;------------------------------------------------------------------------------
        .psect  $$$code,nowrt,exe,long
        .entry  clralmaip,0

        $assign_g       get_channel     ; assign a channel to the disk
        check_status                    ; should we continue?

        $qiow_g xqp_function            ; access the disk's INDEXF.SYS
        check_status    iosb            ; should we continue?

        movl    #io$_acpcontrol,-       ; setup function to remap the
                xqp_function+qio$_func  ; -- entire file

        $qiow_g xqp_function            ; map the entire file, lots o' WCBs
        check_status    iosb            ; should we continue?

        movw    xqp_function+qio$_chan,-  ; put channel number in arg. list
                arglst.channel

        $cmexec_s  routin=vbn_to_lbn,-  ; executive routine to convert
                        arglst=arglst   ; -- VBNs to LBNs

        movl    #io$_deaccess,-         ; setup function to deaccess
                xqp_function+qio$_func  ; -- the INDEXF.SYS file

        $qiow_g xqp_function            ; let the INDEXF.SYS file go...
        check_status    iosb            ; should we continue?

        $qiow_s chan=xqp_function+qio$_chan,-   ; read in the file header
                func=#io$_readlblk,-            ; -- so we may modify it
                iosb=iosb,-                     ; -- to our liking...
                p1=block,-
                p2=#512,-
                p3=arglst.lbn
        check_status    iosb            ; should we continue?

        bbcc    #fh2$v_alm_aip,-        ; clear that damn ALM_AIP bit
                block+fh2$l_filechar,.+1

        clrq    r0                      ; init counter & checksum accumulator

10$:    addw2   block[r0],r1            ; calculate the new checksum value
        aoblss  #255,r0,10$             ; -- for our hand written file header
        movw    r1,block[r0]

        $qiow_s chan=xqp_function+qio$_chan,-   ; put our hand written file
                func=#io$_writelblk,-           ; -- header back in the disk.
                iosb=iosb,-
                p1=block,-
                p2=#512,-
                p3=arglst.lbn
        check_status    iosb            ; should we continue?

        movc5   #0,#0,#0,#fib$k_length,fib      ; start with a fresh fib block

        movw    #fib$c_flush_cache,-    ; need to flush file system caches
                fib+fib$w_cntrlfunc
        movl    #fib$c_bfrd_cache,-     ; specifically, buffer desc. cache
                fib+fib$l_cntrlval

        movl    #io$_acpcontrol,-       ; setup function to flush the file
                xqp_function+qio$_func  ; -- system caches

        $qiow_g xqp_function            ; flush those buffers down the drain
        check_status    iosb            ; should we continue?

; At this point the file is accessible on the local node.  If node is in a
; cluster, we must force the fcb cached on the other VAXcluster nodes to be
; invalidated.  This can be done easily by modifying the file header in such
; a way as to require the file system to invalidate the fcb on other nodes.
; I do this with the extend subfunction; extending the file by zero blocks.
; RTFM: VMS File System Internals, Kirby McCoy, EY-F575E-DP
;       Sec.: 8.5.3, Title: FCB Invalidation,  ppg. 374-382

        movc5   #0,#0,#0,#fib$k_length,fib      ; start with a fresh fib block

        movc3   #fh2$s_fid,block+fh2$w_fid,-    ; get file id of original file
                fib+fib$w_fid
        movc3   #fh2$s_backlink,-               ; get the directory backlink
                block+fh2$w_backlink,-          ; -- file id of original file
                fib+fib$w_did
        movw    #fib$m_findfid,fib+fib$w_nmctl  ; access by file id
        movl    #fib$m_writethru,fib+fib$l_acctl

        movl    #io$_access,-           ; setup function to access the file
                xqp_function+qio$_func  ; -- and fill in the fib

        $qiow_g xqp_function            ; access the file
        check_status    iosb            ; should we continue?

        movw    #fib$m_extend,fib+fib$w_exctl   ; extend subfunction
        clrl    fib+fib$l_exsz                  ; extend file zero blocks

        movl    #io$_modify,-           ; setup function to remap the
                xqp_function+qio$_func  ; -- entire file

        $qiow_g xqp_function            ; access the disk's INDEXF.SYS

        check_status    iosb            ; should we continue?


        $exit_s r0                      ; to exit anyway)
;----------------------------------------------------------------------------
argcnt  = 0
channel = 4
vbn     = 8
lbn     = 12

stlbn   = 2
stlbnsz = 4
        .entry  vbn_to_lbn,0
        movl    @#ctl$gl_ccbbase,r0     ; get base address oc CCB region
        subl2   channel(ap),r0          ; get CCB of channel (rev. indexed)

        movl    ccb$l_wind(r0),r0       ; get 1st window mapping the file
10$:    movl    wcb$l_link(r0),r1       ; are there others???
        beql    20$                     ; NO?? then branch to 20$
        cmpl    vbn(ap),wcb$l_stvbn(r1) ; does our VBN map in this window?
        blssu   20$                     ; NO?? then branch to 20$
        movl    r1,r0                   ; use the next window
        brb     10$                     ; ... and check it out again

20$:    movzwl  wcb$w_nmap(r0),r1       ; how many map pointers in window
        subl2   wcb$l_stvbn(r0),vbn(ap) ; offset by the window's start VBN
        movab   wcb$w_p1_count(r0),r0   ; get the address of mapping pointers
30$:    cmpw    vbn(ap),(r0)            ; is our VBN in this map pointer?
        blssu   40$                     ; YES?? then branch to 40$
        subw2   (r0)+,vbn(ap)           ; offset our VBN by the mapping count
        movab   stlbnsz(r0),r0          ; get address of next mapping pointer
        sobgtr  r1,30$                  ; ... try, try again...
        movl    #ss$_illblknum,r0
        ret

40$:    addl3   vbn(ap),stlbn(r0),lbn(ap)  ; VBN offset + Starting LBN = LBN
        movl    #ss$_normal,r0          ; ok
        ret

        .end    clralmaip