e i g h t - c u b e d . c o m 

Bit tests in COBOL

It's been a long while since I've had anything interesting to post here. Mostly, my day to day occupation for the last couple of years has been maintaining the infrastructure, operating system, and ensuring business as usual continues for the company's primary application.

However, I got an interesting query from an old friend today, asking if there is a way to do bitwise tests in COBOL. This was an interesting challenge that made me think outside the box!

My immediate though was "the only way to test a bit in COBOL, which lacks any bitwise operators, is to use the IS SUCCESS or IS FAILURE clauses of the IF statement". These statements are designed to make it easy to test the success or failure of a CALL, and I'd presume they are platform dependent. On VMS, they test if the least significant bit of a COMP variable is set or clear.

For example, an odd value (one with the low bit set) defines a successful return code on VMS. So, to test any bit, our problem is now redefined as a right shift exercise. Of course, COBOL doesn't have shift operators either, but harking back to our CS knowledge, on a twos compliment integer system, a right shift by X number of bits is the same as division by 2 to the power of X.

It just so happens that VMS has predefined values for all the flag bits it defines. So, for example, you can call SYS$GETUAI and retrieve a 32 bit mask that defines a bunch of stuff about the username, and on a language with bitwise arithmetic, use logical AND with, say, UAI$M_LOCKPWD to see if the password is locked.

UAI$M_LOCKPWD is the appropriate power of two to do our division.

So, without further ado, here's a working example:

identification division.
program-id. testit.
environment division.
data division.
working-storage section.
01 flags pic s9(09) comp.
01 lockpwd pic s9(09) comp value is external UAI$M_LOCKPWD.
01 ret-status pic s9(09) comp.
01 user pic x(12) value is "SYSTEM".
01 result pic s9(09) comp.
01 flags-len pic s9(09) comp.
01 items.
   03 len pic s9(04) comp value 4.
   03 item pic s9(04) comp value is external UAI$_FLAGS.
   03 val pointer value reference flags.
   03 retlen pointer value reference flags-len.
   03 filler pic s9(09) comp value 0.
procedure division.
0-begin. 
    call "sys$getuai" using 	omitted,
				omitted,
			    	by descriptor user,
			    	by reference items,
			    	omitted,
				omitted, 
				omitted 
					giving ret-status.
    if ret-status is failure
        call "lib$signal" using by value ret-status.

    compute result = flags / lockpwd.

    if result is success
        display "password is locked".

0-end.
    stop run.