Comment My gimmicky version of the ENCODE() function

Cecil

19+ years progress programming and still learning.
Hi All

Just for giggles, I thought it would be fun to emulate the ABL ENCODE() function and actually write my own version. This code has been tested and it does seam to work but definitely not to be used in any production or development environment, it's just toooooo slow. "It was only meant to be for fun."

Also I'm still teaching myself OO programming so the structure of the syntax could be better.

OpenEdgeEncode.cls
Code:
/**

THIS CODE HAS BE PORTED TO THE ABL PROGRAMMING LANGUAGE FROM THIS 'C' CODE.
https://github.com/pvginkel/ProgressEncode/blob/master/ProgressEncode/Progress.cs

CRC16 Encode Library for ABL simulate the Native ENCODE() function in the ABL.

**/

CLASS OpenEdgeEncode:

  
    DEFINE PUBLIC PROPERTY Encoded AS CHARACTER GET. PRIVATE SET.   

    CONSTRUCTOR OpenEdgeEncode():
        /** Do Nothing.**/
    END CONSTRUCTOR.

    DESTRUCTOR  OpenEdgeEncode():
        /** Do Nothing.**/
    END DESTRUCTOR.

    METHOD PRIVATE INTEGER RightShift(INPUT pinByte  AS INTEGER,
                                      INPUT pinShiftBy AS INTEGER):

        DEFINE VARIABLE inLoop         AS INTEGER     NO-UNDO.
      
        DO inLoop = 0 TO pinShiftBy - 1:
            pinByte = TRUNCATE(pinByte / 2,0).
        END.

        RETURN pinByte.

    END METHOD.

    METHOD PRIVATE LOGICAL getBIT (INPUT pinBit      AS INTEGER,
                                   INPUT pinBitbit   AS INTEGER):

       DEFINE VARIABLE inBitPos      AS INTEGER     NO-UNDO.
      
       DO inBitPos = 0 TO pinBitbit - 1:
          pinBit = TRUNCATE( pinBit / 2, 0 ).
       END.

       RETURN ( pinBit MODULO 2 ) = 1.
    END METHOD. /* getBIT */

    METHOD PRIVATE INTEGER setBIT (INPUT pinBit      AS INTEGER,
                                   INPUT pinBitbit   AS INTEGER):

       IF NOT getBIT( pinBit, pinBitbit ) THEN
          pinBit = pinBit + EXP( 2, pinBitbit ).

       RETURN pinBit.
    END METHOD. /* setBIT */

    METHOD PRIVATE INTEGER and (INPUT pinBit1     AS INTEGER,
                                INPUT pinBit2     AS INTEGER):

       DEFINE VARIABLE inBitPos AS INTEGER     NO-UNDO.
       DEFINE VARIABLE inResult AS INTEGER     NO-UNDO.

       DO inBitPos = 0 TO 15:
          IF getBIT( pinBit1, inBitPos ) AND
             getBIT( pinBit2, inBitPos )
          THEN
             inResult = setBIT( inResult, inBitPos ).
       END.

       RETURN inResult.
    END METHOD. /* band */
  
    METHOD PRIVATE INTEGER xor (INPUT int1 AS INTEGER,
                                INPUT int2 AS INTEGER):

       DEFINE VARIABLE inBitPos AS INTEGER     NO-UNDO.
       DEFINE VARIABLE inResult AS INTEGER     NO-UNDO.

       DO inBitPos = 0 TO 15:
          IF getBIT( int1, inBitPos ) NE getBIT( int2, inBitPos )
          THEN
             inResult = setBIT( inResult, inBitPos ).
       END.
       RETURN inResult.

    END METHOD.

    METHOD PUBLIC CHARACTER ENCODE(INPUT pchString AS CHARACTER):
      
        DEFINE VARIABLE mpString        AS MEMPTR      NO-UNDO.
        DEFINE VARIABLE inStringLength  AS INTEGER     NO-UNDO.

        inStringLength = LENGTH(pchString,'RAW').

        IF LOGICAL(inStringLength) THEN
        DO:
            SET-SIZE(mpString)                    = 0.
            SET-SIZE(mpString)                    = inStringLength.
            PUT-STRING(mpString,1,inStringLength) = pchString.
        END.

        RETURN THIS-OBJECT:ENCODE(INPUT mpString).

    END METHOD.

    METHOD PUBLIC CHARACTER ENCODE(INPUT pmpString AS MEMPTR):
  
        DEFINE VARIABLE inHash      AS INTEGER     NO-UNDO INITIAL 17.
        DEFINE VARIABLE mpScratch   AS MEMPTR      NO-UNDO.
        DEFINE VARIABLE mptarget    AS MEMPTR      NO-UNDO.
        DEFINE VARIABLE inLoop      AS INTEGER     NO-UNDO.
        DEFINE VARIABLE inInnerLoop AS INTEGER     NO-UNDO.
        DEFINE VARIABLE inBytePos   AS INTEGER     NO-UNDO.
        DEFINE VARIABLE inLower     AS INTEGER     NO-UNDO.
      
        SET-SIZE(mpScratch) = 0.
        SET-SIZE(mpScratch) = 16.

        DO inLoop = 1 TO 5:

            DO inInnerLoop = 0 TO GET-SIZE(pmpString) - 1:

                inBytePos = 16 - (inInnerLoop MOD 16) .

                PUT-BYTE(mpScratch, inBytePos) = THIS-OBJECT:xor(GET-BYTE(mpScratch, inBytePos),
                                                                 GET-BYTE(pmpString, inInnerLoop + 1)
                                                                 ).
            END.

           DO inInnerLoop = 1 TO 16 BY 2:

                inHash = THIS-OBJECT:Hash(mpScratch, inHash).

                PUT-BYTE(mpScratch,inInnerLoop)     = THIS-OBJECT:and(inHash, 0xFF).
                PUT-BYTE(mpScratch,inInnerLoop + 1) = THIS-OBJECT:and( THIS-OBJECT:RightShift( inHash, 8 ), 0xFF).
           END.
        END.

        SET-SIZE(pmpString) = 0.
        SET-SIZE(mptarget)  = 0.
        SET-SIZE(mptarget)  = 16.

        DO inLoop = 1 TO 16:

            inLower =  THIS-OBJECT:and( GET-BYTE(mpScratch,inLoop), 0x7F ) .

            IF (inLower GE ASC('A') AND inLower LE ASC('Z')) OR
               (inLower GE ASC('a') AND inLower LE ASC('z')) THEN
                PUT-BYTE(mptarget,inLoop) = inLower.
            ELSE
                PUT-BYTE(mptarget,inLoop) = THIS-OBJECT:RightShift( GET-BYTE(mpScratch,inLoop), 4 ) + 0x61. /** HEX '0x61' DEC '97' ASCII 'a' **/
        END.
      
        THIS-OBJECT:Encoded = GET-STRING(mptarget,1,16).

        SET-SIZE(mptarget)  = 0.
        SET-SIZE(mpScratch) = 0.

        RETURN THIS-OBJECT:Encoded.
  
    END METHOD.

    METHOD PRIVATE INTEGER Hash( INPUT mpScratch AS MEMPTR,
                                 INPUT pinHash    AS INTEGER ):
      
        DEFINE VARIABLE hashLookup AS INTEGER EXTENT 256 INITIAL 
         [0x0000, 0xC0C1, 0xC181, 0x0140, 0xC301, 0x03C0, 0x0280, 0xC241,
          0xC601, 0x06C0, 0x0780, 0xC741, 0x0500, 0xC5C1, 0xC481, 0x0440,
          0xCC01, 0x0CC0, 0x0D80, 0xCD41, 0x0F00, 0xCFC1, 0xCE81, 0x0E40,
          0x0A00, 0xCAC1, 0xCB81, 0x0B40, 0xC901, 0x09C0, 0x0880, 0xC841,
          0xD801, 0x18C0, 0x1980, 0xD941, 0x1B00, 0xDBC1, 0xDA81, 0x1A40,
          0x1E00, 0xDEC1, 0xDF81, 0x1F40, 0xDD01, 0x1DC0, 0x1C80, 0xDC41,
          0x1400, 0xD4C1, 0xD581, 0x1540, 0xD701, 0x17C0, 0x1680, 0xD641,
          0xD201, 0x12C0, 0x1380, 0xD341, 0x1100, 0xD1C1, 0xD081, 0x1040,
          0xF001, 0x30C0, 0x3180, 0xF141, 0x3300, 0xF3C1, 0xF281, 0x3240,
          0x3600, 0xF6C1, 0xF781, 0x3740, 0xF501, 0x35C0, 0x3480, 0xF441,
          0x3C00, 0xFCC1, 0xFD81, 0x3D40, 0xFF01, 0x3FC0, 0x3E80, 0xFE41,
          0xFA01, 0x3AC0, 0x3B80, 0xFB41, 0x3900, 0xF9C1, 0xF881, 0x3840,
          0x2800, 0xE8C1, 0xE981, 0x2940, 0xEB01, 0x2BC0, 0x2A80, 0xEA41,
          0xEE01, 0x2EC0, 0x2F80, 0xEF41, 0x2D00, 0xEDC1, 0xEC81, 0x2C40,
          0xE401, 0x24C0, 0x2580, 0xE541, 0x2700, 0xE7C1, 0xE681, 0x2640,
          0x2200, 0xE2C1, 0xE381, 0x2340, 0xE101, 0x21C0, 0x2080, 0xE041,
          0xA001, 0x60C0, 0x6180, 0xA141, 0x6300, 0xA3C1, 0xA281, 0x6240,
          0x6600, 0xA6C1, 0xA781, 0x6740, 0xA501, 0x65C0, 0x6480, 0xA441,
          0x6C00, 0xACC1, 0xAD81, 0x6D40, 0xAF01, 0x6FC0, 0x6E80, 0xAE41,
          0xAA01, 0x6AC0, 0x6B80, 0xAB41, 0x6900, 0xA9C1, 0xA881, 0x6840,
          0x7800, 0xB8C1, 0xB981, 0x7940, 0xBB01, 0x7BC0, 0x7A80, 0xBA41,
          0xBE01, 0x7EC0, 0x7F80, 0xBF41, 0x7D00, 0xBDC1, 0xBC81, 0x7C40,
          0xB401, 0x74C0, 0x7580, 0xB541, 0x7700, 0xB7C1, 0xB681, 0x7640,
          0x7200, 0xB2C1, 0xB381, 0x7340, 0xB101, 0x71C0, 0x7080, 0xB041,
          0x5000, 0x90C1, 0x9181, 0x5140, 0x9301, 0x53C0, 0x5280, 0x9241,
          0x9601, 0x56C0, 0x5780, 0x9741, 0x5500, 0x95C1, 0x9481, 0x5440,
          0x9C01, 0x5CC0, 0x5D80, 0x9D41, 0x5F00, 0x9FC1, 0x9E81, 0x5E40,
          0x5A00, 0x9AC1, 0x9B81, 0x5B40, 0x9901, 0x59C0, 0x5880, 0x9841,
          0x8801, 0x48C0, 0x4980, 0x8941, 0x4B00, 0x8BC1, 0x8A81, 0x4A40,
          0x4E00, 0x8EC1, 0x8F81, 0x4F40, 0x8D01, 0x4DC0, 0x4C80, 0x8C41,
          0x4400, 0x84C1, 0x8581, 0x4540, 0x8701, 0x47C0, 0x4680, 0x8641,
          0x8201, 0x42C0, 0x4380, 0x8341, 0x4100, 0x81C1, 0x8081, 0x4040].

        DEFINE VARIABLE inLoop       AS INTEGER     NO-UNDO.
        DEFINE VARIABLE inHashTemp AS INTEGER     NO-UNDO.

        DO inLoop = 16 TO 1 BY -1:

            inHashTemp = THIS-OBJECT:RightShift(pinHash , 8).

            inHashTemp = THIS-OBJECT:xor(inHashTemp, hashLookup[ THIS-OBJECT:and( pinHash , 0xFF) + 1 ] ).

            inHashTemp = THIS-OBJECT:xor(inHashTemp , hashLookup[ GET-BYTE(mpScratch, inLoop) + 1 ] ).

            pinHash = inHashTemp.
        END.
        RETURN pinHash.
     END METHOD.

END CLASS.

How to call the OpenEdgeEncoded Object:

Code:
DEFINE VARIABLE oencode AS CLASS OpenEdgeEncode  NO-UNDO.

DEFINE VARIABLE chPassword AS CHARACTER   NO-UNDO.
oencode = NEW OpenEdgeEncode().   

chPassword = "abcdefghijklmnopqrstuvwxyz".

oencode:encode(chPassword).

/** Compare the results between ABL ENCODE() function and gimmicky slower version. **/
IF oencode:Encoded EQ encode(chPassword) THEN
    MESSAGE
        "WOOO HOO, SUCCESS!" SKIP
        chPassword '=' oencode:Encoded
        VIEW-AS ALERT-BOX INFO.
ELSE
    MESSAGE
        "BUGGER! FAILED!"
        VIEW-AS ALERT-BOX ERROR.

DELETE OBJECT oencode.
 
Last edited:

Cecil

19+ years progress programming and still learning.
Those bit methods look very much copy / pasted
Yeah, I was wounding how long it might take you to see that. It was most definitely copied, pasted & bastardised. I just need an Bitwise XOR & ANDding function and that's what Google showed up.
I know that OpenEdge does have a XOR and AND method, but it's only for Windows+.NET clients. I'll need to complain about that to Rob Straight at Progress about that one.

Writing the DECODE() function should only take me a few hours as it only doing the hashing in reverse, right???? ;p
 

Rob Fitzpatrick

ProgressTalk.com Sponsor
I'd love to see ABL functions for XOR, right and left shifts, base conversions, etc. I doubt we'll get it though.
 

Cecil

19+ years progress programming and still learning.
I'd love to see ABL functions for XOR, right and left shifts, base conversions, etc. I doubt we'll get it though.
Has a feature request ever been posted to Progress? Now Progress have ditched some of there frilly products and returning to there Core database and the ABL language, apparently there is now more development focus on the ABL. They are focusing more of the little guy (you and me) and there desperately trying not to be dictated by there largest customers.
 

Rob Fitzpatrick

ProgressTalk.com Sponsor
Has a feature request ever been posted to Progress?

I admit I don't know. I had a chat a few years ago with Mary Szekely about base conversion etc. and whether there had ever been any demand for such features in the language. She said there hadn't been.

It can't hurt to ask officially, or to submit an enhancement "idea" on the community site. More broadly, I'm wondering whether they would consider shipping libraries with the OpenEdge runtime so developers could take advantage of routines to complete common tasks without having to write them themselves.
 

Cringer

ProgressTalk.com Moderator
Staff member
XOR would have been really useful on a project I did a few years back. Was interfacing with an API that returned error codes that had been XORed IIRC. Had to write a routine to parse the codes and report the actual errors to the user. Took ages.
 

Cecil

19+ years progress programming and still learning.
Sorry if I'm teaching you to how to suck the metaphorical egg, but did you know that you can assign a integer a with a hexadecimal value.??

I've edit my sample code above. I don't think it effects performance of the ABL code but sure does make it look pretty.


Code:
DEFINE VARIABLE hashLookup AS INTEGER EXTENT 256 INITIAL [0x0000, 0xC0C1, 0xC181, 0x0140, 0xC301, 0x03C0, 0x0280, 0xC241,
                                                                  0xC601, 0x06C0, 0x0780, 0xC741, 0x0500, 0xC5C1, 0xC481, 0x0440,
                                                                  0xCC01, 0x0CC0, 0x0D80, 0xCD41, 0x0F00, 0xCFC1, 0xCE81, 0x0E40,
                                                                  0x0A00, 0xCAC1, 0xCB81, 0x0B40, 0xC901, 0x09C0, 0x0880, 0xC841,
                                                                  0xD801, 0x18C0, 0x1980, 0xD941, 0x1B00, 0xDBC1, 0xDA81, 0x1A40,
                                                                  0x1E00, 0xDEC1, 0xDF81, 0x1F40, 0xDD01, 0x1DC0, 0x1C80, 0xDC41,
                                                                  0x1400, 0xD4C1, 0xD581, 0x1540, 0xD701, 0x17C0, 0x1680, 0xD641,
                                                                  0xD201, 0x12C0, 0x1380, 0xD341, 0x1100, 0xD1C1, 0xD081, 0x1040,
                                                                  0xF001, 0x30C0, 0x3180, 0xF141, 0x3300, 0xF3C1, 0xF281, 0x3240,
                                                                  0x3600, 0xF6C1, 0xF781, 0x3740, 0xF501, 0x35C0, 0x3480, 0xF441,
                                                                  0x3C00, 0xFCC1, 0xFD81, 0x3D40, 0xFF01, 0x3FC0, 0x3E80, 0xFE41,
                                                                  0xFA01, 0x3AC0, 0x3B80, 0xFB41, 0x3900, 0xF9C1, 0xF881, 0x3840,
                                                                  0x2800, 0xE8C1, 0xE981, 0x2940, 0xEB01, 0x2BC0, 0x2A80, 0xEA41,
                                                                  0xEE01, 0x2EC0, 0x2F80, 0xEF41, 0x2D00, 0xEDC1, 0xEC81, 0x2C40,
                                                                  0xE401, 0x24C0, 0x2580, 0xE541, 0x2700, 0xE7C1, 0xE681, 0x2640,
                                                                  0x2200, 0xE2C1, 0xE381, 0x2340, 0xE101, 0x21C0, 0x2080, 0xE041,
                                                                  0xA001, 0x60C0, 0x6180, 0xA141, 0x6300, 0xA3C1, 0xA281, 0x6240,
                                                                  0x6600, 0xA6C1, 0xA781, 0x6740, 0xA501, 0x65C0, 0x6480, 0xA441,
                                                                  0x6C00, 0xACC1, 0xAD81, 0x6D40, 0xAF01, 0x6FC0, 0x6E80, 0xAE41,
                                                                  0xAA01, 0x6AC0, 0x6B80, 0xAB41, 0x6900, 0xA9C1, 0xA881, 0x6840,
                                                                  0x7800, 0xB8C1, 0xB981, 0x7940, 0xBB01, 0x7BC0, 0x7A80, 0xBA41,
                                                                  0xBE01, 0x7EC0, 0x7F80, 0xBF41, 0x7D00, 0xBDC1, 0xBC81, 0x7C40,
                                                                  0xB401, 0x74C0, 0x7580, 0xB541, 0x7700, 0xB7C1, 0xB681, 0x7640,
                                                                  0x7200, 0xB2C1, 0xB381, 0x7340, 0xB101, 0x71C0, 0x7080, 0xB041,
                                                                  0x5000, 0x90C1, 0x9181, 0x5140, 0x9301, 0x53C0, 0x5280, 0x9241,
                                                                  0x9601, 0x56C0, 0x5780, 0x9741, 0x5500, 0x95C1, 0x9481, 0x5440,
                                                                  0x9C01, 0x5CC0, 0x5D80, 0x9D41, 0x5F00, 0x9FC1, 0x9E81, 0x5E40,
                                                                  0x5A00, 0x9AC1, 0x9B81, 0x5B40, 0x9901, 0x59C0, 0x5880, 0x9841,
                                                                  0x8801, 0x48C0, 0x4980, 0x8941, 0x4B00, 0x8BC1, 0x8A81, 0x4A40,
                                                                  0x4E00, 0x8EC1, 0x8F81, 0x4F40, 0x8D01, 0x4DC0, 0x4C80, 0x8C41,
                                                                  0x4400, 0x84C1, 0x8581, 0x4540, 0x8701, 0x47C0, 0x4680, 0x8641,
                                                                  0x8201, 0x42C0, 0x4380, 0x8341, 0x4100, 0x81C1, 0x8081, 0x4040].
 

Cecil

19+ years progress programming and still learning.
It seems to me I heard this before but forgot about it. Neat trick. Is it documented? I can't find it anywhere in the docs or KB.

As far as I know it's not documented or in any KB. Peter Judge from Progress told me this trick. I wonder how many other hidden ticks like this exist???
 

TomBascom

Curmudgeon
>Does anybody have any ideas how to
>realize bit operations on Progress 4GL?
>For example, exclusive OR.

Take a look to pkb #18648 titled "Functions that Implement Bit Manipulation"

Other way is to use an undocumented Progress function _cbit("string",
bit_position). It returns True/False.

HTH,
George Potemkin

Check out KBase articles #21104 and #21355.

None of those articles seem to be in the current online kbase but maybe some of you guys with old copies of the downloadable kbase can find them.
 

Rob Fitzpatrick

ProgressTalk.com Sponsor
Huh. The _cbit function does indeed work, though nothing in the current KB about it.

Can't find any articles like 21104 or 21355. Are they old "Primus" numbers?

Also can't find "Functions That Implement Bit Manipulation" or anything similar. I have rcode for an old KB app but I have the wrong DLC version for it; it wants version 820. Anyone know which version of Progress used that compiler version? The oldest I have is 9.1D which is version 908 (0x038C).
 

Cecil

19+ years progress programming and still learning.
Huh. The _cbit function does indeed work, though nothing in the current KB about it.

I used the _cbit function years ago for my HMAC function. I was tolled because it's an undocumented function it was a "no, no" and should not be used.
 

Cecil

19+ years progress programming and still learning.
I've tweaked the Bitwise methods and it's had huge performance improvement and I did not have to use the _cbit function.

The improved XOR and AND methods:
Code:
    METHOD PRIVATE INTEGER BinaryAND (INPUT pinBit1     AS INTEGER,
                                      INPUT pinBit2     AS INTEGER):

       DEFINE VARIABLE inBitPos AS INTEGER     NO-UNDO.
       DEFINE VARIABLE inResult AS INTEGER     NO-UNDO.

       DO inBitPos = 0 TO 15:
          IF LOGICAL(GET-BITS( pinBit1, inBitPos + 1, 1 )) AND
             LOGICAL(GET-BITS( pinBit2, inBitPos + 1, 1 )) THEN
              inResult = inResult + EXP(2, inBitPos ).
       END.

       RETURN inResult.
    END METHOD. /* End of METHOD BinaryAND */

    METHOD PRIVATE INTEGER BinaryXOR (INPUT intOperand1 AS INTEGER,
                                      INPUT intOperand2 AS INTEGER):

        DEFINE VARIABLE iByteLoop  AS INTEGER NO-UNDO.
        DEFINE VARIABLE iXOResult  AS INTEGER NO-UNDO.
        DEFINE VARIABLE lFirstBit  AS LOGICAL NO-UNDO.
        DEFINE VARIABLE lSecondBit AS LOGICAL NO-UNDO.
    
        iXOResult = 0.
    
        /*spin through each byte of each char*/
        DO iByteLoop = 0 TO 15: /* as processing a double byte character */
            /*find state (true / false) of each integer's byte*/
            ASSIGN
            lFirstBit  = LOGICAL(GET-BITS(intOperand1,iByteLoop + 1,1))
            lSecondBit = LOGICAL(GET-BITS(intOperand2,iByteLoop + 1,1)).
    
            /* XOR each bit*/
            IF (lFirstBit AND NOT lSecondBit) OR
               (lSecondBit AND NOT lFirstBit) THEN
                iXOResult = iXOResult + EXP(2, iByteLoop).
        END.                                                 
        RETURN iXOResult.
    END METHOD. /*End of METHOD BinaryXOR */
 

Cecil

19+ years progress programming and still learning.
So just out of curiosity Cecil, how did you come up with the encode algorithm? (If you're willing to share.)

On Monday morning I was Googling around looking for something to with the key words Progress & CRC16 and I stumbled on this C code.
https://github.com/pvginkel/ProgressEncode
https://github.com/pvginkel/ProgressEncode
Not knowing how to write in the 'C' language I was still able to understand what it was sort of doing. It had some simple loops and few BitWise operator been mixed in. More Googling on trying understand the C syntax i.e >> =^ &. I was able line-by-line able to piece it all together in the ABL. Come Tuesday morning I had it working.

I had a few bugs which was causing me headaches, but I knew it was sort of working when my initial testing was producing a 16bit string which was looking almost identical to which the native ABL ENCODE() function. I was delighted when I was getting a duplicate results with a blank password and I knew it was 90% working.

That's it.

N.B. The funny thing is, I can't quite remember what I was suppose to be doing on Monday morning, but it was not writing code to emulate the ENCODE() function.

Also I had to copy
Stefan XOR & AND functions.
 

Stefan

Well-Known Member
A few optimizations (from my early Z80 coding days ;-)):

1. EXP is fairly expensive, use a pre-calculated lookup table, this translates to an extent:
2. self modifying code is good - this translates to remove intermediate variables
3. XOR is true when bit 1 <> bit 2 - no need to do all the dancing around handling all combinations - your signature may need an update ;-)
4. loops are bad and should be unrolled - this translates to shift once instead of in loops

Code:
   DEFINE VARIABLE iexp AS INT EXTENT 16 INITIAL [ 1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384, 32768 ].

   METHOD PRIVATE INTEGER RightShift(
      i_ivalue AS INTEGER,
      i_ishift AS INTEGER
   ):

      RETURN INTEGER( TRUNCATE( i_ivalue / iexp[ i_ishift + 1], 0 ) ).

   END METHOD.


   METHOD PRIVATE INTEGER BinaryAND (
      i_ivalue_1 AS INTEGER,
      i_ivalue_2 AS INTEGER
   ):  
       DEFINE VARIABLE icbit     AS INTEGER     NO-UNDO.
       DEFINE VARIABLE iresult   AS INTEGER     NO-UNDO.

       DO icbit = 1 TO 16:
          IF LOGICAL( GET-BITS( i_ivalue_1, icbit, 1 ) ) AND
             LOGICAL( GET-BITS( i_ivalue_2, icbit, 1 ) ) 
          THEN
             PUT-BITS( iresult, icbit, 1 ) = 1.
      END.

      RETURN iresult.

   END METHOD. /* End of METHOD BinaryAND */

   METHOD PRIVATE INTEGER BinaryXOR (
      i_ivalue_1  AS INTEGER,
      i_ivalue_2  AS INTEGER
   ):

      DEFINE VARIABLE icbit    AS INTEGER NO-UNDO.
      DEFINE VARIABLE iresult  AS INTEGER NO-UNDO.
   
      DO icbit = 1 TO 16:
         IF LOGICAL( GET-BITS( i_ivalue_1, icbit, 1 ) ) <> 
            LOGICAL( GET-BITS( i_ivalue_2, icbit, 1 ) ) 
         THEN
             PUT-BITS( iresult, icbit, 1 ) = 1.
      END.

      RETURN iresult.

   END METHOD. /*End of METHOD BinaryXOR */

I initially used iexp when replacing the EXPs, but switched to PUT-BITS for its elegance.
 
Top