.title SHOWDISKS Show writable disk condition .sbttl Documentation .ident /V2.05/ ; ; ; Don't ask me why i did this -- i think it was for the ; sheer torture of it all. This does the same thing as ; a much simpler FORTRAN program, except this one does ; it in macro. if you want to really mess with your own ; mind, try to work through all the trash that this thing ; does. If you don't really like self-torment, pitch this ; and use the fortran one! ; ; Eric F. Richards ; 06-Mar-86 ; Gould OSD VAXcluster VAX/VMS V4.3 ; ; .sbttl Macros and other constants .enable suppression ; clean up the listing files .disable traceback, debug ; hands off w/ debugger .default displacement, word ; program < 32K bytes $ssdef ; define system service codes $rmsalldef ; define ALL RMS stuff linsiz = 80 ; output line length logsiz = 64 ; logical name buffer size bufsiz = 1020 ; initial main buffer size dsksiz = 16 ; single disk buffer size maxbuf = 65535 ; maximum disk buffer size assume bufsiz le maxbuf ; if not, it'll not work right .macro clrsp space, fill=#0 ; macro for clearing space subl space, sp ; on stack for a data area. movc5 #0, (sp), fill, - ; data area is init'd to space, (sp) ; nulls by this macro .endm clrsp ; that's it! .sbttl Main Code .page .psect $code, long, exe, nowrt, pic, shr .entry showdisks, ^m pushal linctr ; build a descr for the line control pushl s^#ctrsiz ; ...string movl sp, r10 ; save a pointer to it movl #bufsiz, r9 ; set initial buffer size subl #logsiz, sp ; make room for the logical pushl sp ; ...build a descriptor for it pushl #logsiz ; ...including length movl sp, r8 ; save a pointer to it subl #linsiz, sp ; make room for the output buffer movl sp, r6 ; save a pointer to this descriptor clrsp #fab$c_bln ; build a FAB movl sp, r7 ; save a pointer to it assume fab$b_bln eq fab$b_bid+1 ; make next instruction work movw #!fab$c_bid,- ; load the FAB ID stuff fab$b_bid(r7) ; into the newly created FAB $fab_store fab=(r7), - ; load up some stuff in this FAB fna=out, - ; use this as the output channel fns=s^#out_len, - ; this is its length org=seq, - ; sequential file type rat=cr, - ; CR/LF attributes rfm=var, - ; variable length format fop=cif ; create it if it isn't there $create fab=(r7) ; open the file blbc r0, 5$ ; on error... die here clrsp #rab$c_bln ; build a RAB movl sp, r11 ; save a pointer to it assume rab$b_bln eq rab$b_bid+1 ; make next instruction work movw #!rab$c_bid,- ; load the RAB ID stuff rab$b_bid(r11) ; into the newly created RAB $rab_store rab=(r11), - ; fill in the blanks in this RAB fab=(r7), - ; point to this FAB rbf=(r6), - ; this is the record to output rop=eof ; start at EOF if an existing file $connect rab=(r11) ; connect the record streams blbc r0, 5$ ; on error get out pushl r6 ; build a descriptor for the line pushl #linsiz ; ...incuding length movl sp, r6 ; save a pointer to descr only subl #dsksiz, sp ; make room for a single name pushl sp ; build descr for it as well pushl #dsksiz ; ...size of the buffer movl sp, r7 ; save a pointer to the descr pushal header ; build a descriptor for the header pushl #hdsize ; ...including length movl sp, r0 ; ...save a pointer... $fao_s ctrstr=(r0), - ; format and build output string outlen=rab$w_rsz(r11),- ; write length in OUTRAB outbuf=(r6) ; write output here blbc r0, 5$ ; on error get out $put rab=(r11) ; print the record blbs r0, 10$ ; on error go away 5$: brw done ; this is the set-up error handler 10$: ; no errors so far, keep going... clrl -(sp) ; build a buffer for the context movl sp, r5 ; ...save a pointer to it clrq -(sp) ; make room for MAXBLOCKS, tot free movl sp, r3 ; ...save a pointer to it clrq -(sp) ; make room for FREEBLOCKS, tot free movl sp, r2 ; ...save a pointer to it ; ; We loop back here if our buffer is too small to hold all the disks ; retry: subl3 r9, r2, sp ; make room for all the disks pushl sp ; build descriptor for it pushl r9 ; ...size of the buffer movl sp, r4 ; save a ptr to the descr ; ; Call GETDISKS to get the drives. This is the main loop. ; loop: movw #dsksiz, (r7) ; init disk name descriptor pushl r7 ; 4th arg is the disk length pushl r7 ; 3rd arg is the disk name descr pushl r5 ; 2nd arg is the usrbuf context pushl r4 ; 1st arg it the usrbuf descr calls #4, getdisks ; get the disk name cmpw #ss$_normal, r0 ; did we get it? beql 10$ ; if so, continue cmpw #ss$_ivbuflen, r0 ; buffer size problems? bnequ done ; if not, get out ashl #1, r9, r9 ; if so, double buffer size cmpl #maxbuf, r9 ; did we go too far? bgtr retry ; if so, error out brb done ; otherwise, reconstruct the buffers 10$: movw #logsiz, (r8) ; init logical name descr ; ; Get disk information. this includes number of freeblocks, maxblocks, ; and the logical name (and length). error codes will be returned if ; the disk is 1) foreign, 2) not mounted, 3) not read-write ; pushl r2 ; address for FREEBLOCKS pushl r3 ; address for MAXBLOCKS pushl r8 ; address to write logical name length pushl r8 ; descriptor for the name itself pushl r7 ; descriptor for the input disk name calls #5, diskinfo ; get the disk information blbc r0, loop ; an error means we don't want this dsk addl (r2), 4(r2) ; update total free block count addl (r3), 4(r3) ; update total block count bsbb doline ; output a formatted data line blbs r0, loop ; loop until done done: cmpw #ss$_nosuchdev, r0 ; is this a normal exit? bneq 30$ ; if not, return with error movl 4(r2), (r2) ; set totals into displayable area movl 4(r3), (r3) ; ditto above comment clrw (r7) ; null out device name moval total, 4(r8) ; mung up logical name descr movw s^#totsiz, (r8) ; with "total" subheading bsbb doline ; print out this line 30$: $exit_s code=r0 ; close output channel, exit ret ; this instruction never executes doline: pushr #^m ; use R4, R5 as scratch movl sp, r5 ; save stack pointer movq (r7), -(sp) ; make a MUNGable copy of the descr movl sp, r4 ; save its address tstw (r4) ; do we have a null descr? beql 10$ ; if so, skip this nonsence cmpb @4(r4), #^a/_/ ; do we have an underscore prefix? bneq 10$ ; if not, skip this stuff incl 4(r4) ; change address of descr to skip "_" decw (r4) ; change length to match 10$: emul #100, (r2), #0, r0 ; r0-r1 has free * 100 (quadword) ediv (r3), r0, r9, r0 ; quotient on r9, remainder in r0 emul #100, r0, #0, r0 ; 2 digits precision on rem ediv (r3), r0, r1, r0 ; turn fraction into decimal $fao_s ctrstr=(r10), - ; prep the output outlen=rab$w_rsz(r11),- ; write length in OUTRAB outbuf=(r6), - ; write output here p1=r4, - ; display the disk name p2=r8, - ; display the logical name p3=(r3), - ; display the maximum block count p4=(r2), - ; display the free block count p5=r9, - ; display the whole num % free p6=r1 ; display the fractional part blbc r0, 50$ ; on errror complain $put rab=(r11) ; print out the line 50$: movl r5, sp ; restore stack pointer popr #^m ; restore R4, R5 rsb ; go back to mainline .sbttl Control strings for FAO total: .repeat 20 ; pad w/ this many spaces .ascii " " ; (dependant on field width set below) .endr ; ...end the padding .ascii "Total" ; this goes in the log name field totsiz = . - total ; this is its length header: .ascii "!19" ; these are the column headings .ascii "!28" ; for each element displayed .ascii "!13" ; as well as spacing inbetween .ascii "!14" ; ... .ascii "% Free" ; ... hdsize = . - header ; length set here linctr: .ascii "!19AS!26AS!12UL!13UL!7UB.!2ZB" ; data line control string ctrsiz = . - linctr ; ...and its length out: .ascii /SYS$OUTPUT:/ ; this is the output channel out_len = . - out ; this is the length .end showdisks ; this is it!!