🚀 go-pugleaf

>I was experimenting with the various ALM bits that could be set in
>the UCHAR longword in a file header and managed to set FH2$V_ALM_AIP
>(Archive In Progress).
>
>This bit seems to be unclearable.  I'll send an "Atta-boy" to
>the first person to figure out how to at least let me erase
>the file without having to reinit the disk it's on.
>[...]
>Jonathan Welch  VAX Systems Manager  Umass/Amherst  JHWELCH@ecs.umass.edu

Well... much to my chagrin, I was conscripted into performing my civic
duty this week. Yes, Jury duty... complete with its $5.00 a day recompense.
I never got on a case and had a lot of free time to compose a macro program
for the above request on my papyrus laptop computer... (I hate working with
its 'pointing device')

I was released from Jury duty today, so I typed it in, fixed a few minor bug-
gers, and here it is...

This is a stripped down quick and dirty.  Other bits of error checking could
applied.

        .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
                .word           fib$c_remap
                .=fib+fib$w_nmctl
                .word           fib$m_findfid
                .=fib+fib$k_length

iosb:   .quad   0
sys_disk:       .ascid  /YOURDISK/      ;<<<*** BYOD! you supply the drive

arglst:
arglst.argcnt:  .long   3
arglst.channel: .long   0
arglst.vbn:     .long   3112    ;<<<*** 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  fixfilehdr,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    #fch$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]

        ; logical write is done here since the vitrual write is blocked
        ; due to that nasty ALM_AIP bit...

        $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 remap the
                xqp_function+qio$_func  ; -- entire file

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

        check_status    iosb            ; should we continue?
                                        ; (really not necessary, we're going
        $exit_s r0                      ; to exit anyway)
;----------------------------------------------------------------------------
argcnt  = 0
channel = 4
vbn     = 8     ; the vbn comes in but it doesn't go back!!
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    fixfilehdr