Qbasicnews.com

Full Version: Rotate left 2 bits (like assembler)
You're currently viewing a stripped down version of our content. View the full version with proper formatting.
Pages: 1 2 3 4 5 6 7 8 9 10
logiclrd,

I compiled and ran your code as is, that is, the rol2 version. I compared you output against known results, and, congratulations, it works 100%.

Sad to say, I never use Peeks and Pokes, so I don't understand what your doing. You might want to explain it.

Anyway, good job!
*****
He is using ASM to do the dirt work.

PEEK and POKE just takes BYTE values..

Lots of fancy code for nothing really..
Stop trying to cloud the issue, Z!re :-)

Moneo: There are, as you have of course noticed, two distinct implementations of ROL2 in my example. I assume you did not test the assembler version because your original challenge indicated that a solution that did not use assembler was desired.

PEEK and POKE are functions which directly access memory. A computer's memory stores values organized into 8-bit bytes. When you use an INTEGER or LONG, which are 16 and 32 bits wide each, QBASIC is actually using 2 and 4 bytes, respectively, in memory.

System memory is one continuous block of bytes; if you have 32 megabytes of RAM, then you can think of, at least at the hardware level, a giant array with 32 million bytes in it. However, the processor doesn't offer access to the memory in this way.

In real mode, which is the name for the processor mode that QBASIC runs in, memory addresses are not 32-bit indices into that giant array, but are instead formed of two 16-bit values. Memory is divided into "segments" (the first part of the address), and within each segment, 64 kilobytes of memory are accessible through an "offset" (the second part of the address). Complicating the issue, though, is that the segments aren't separate sections of memory. Instead, they overlap at regular 16-byte boundaries. That is to say, segment 0 is the very start of memory, segment 1 starts 16 bytes into memory, segment 2 starts 32 bytes into memory, etc. Thus, a real mode address, which is of the form "segment:offset", actually refers to the byte at offset (segment * 16 + offset). Most bytes of memory have many different segment:offset pairs referring to the same byte.

This may seem like a bit of a pointless organization, but it made the original x86 processors easier for Intel to design. The largest values the processors could store were only 16 bits, so it wasn't actually possible to directly store the address in memory. Nowadays, there are other modes than real mode where 32-bit addresses are possible, but QBASIC was made before those modes were invented. :-)

QBASIC's syntax integrates with this system using DEF SEG and PEEK/POKE. Every variable in QBASIC has a memory address. QBASIC allocates one or more 64 kilobyte chunks of memory in which to put the variables. Each of these chunks corresponds to a certain segment, and this is called the "data segment" (as opposed to the "code segment" where the actual machine code for the program resides). I mentioned that QBASIC can in fact allocate more than one data segment; therefore, to directly access a variable in memory, you need to determine which data segment it is in. You can request this from QBASIC with the VARSEG function; it returns an INTEGER value that refers to the segment containing the variable you pass to it. The other half of the address is the offset into that segment, and you can get that with the VARPTR function. My example uses both of these in order to get the full "real mode" address of the variable passed to the function.

PEEK and POKE, then, read and write individual bytes of memory, completely outside of QBASIC's variable system, but using VARSEG and VARPTR, you can use PEEK and POKE to access variables being managed by QBASIC. There is one minor snag, though, and that is that PEEK and POKE only take the offset part of the address. In order to pair that up with the correct segment, QBASIC keeps track of a "current segment". This is what DEF SEG sets. Thus, when my code does this:

Code:
DEF SEG = VARSEG(a%)
ptr% = VARPTR(a%)
l% = PEEK(ptr%)
h% = PEEK(ptr% + 1)

..it is telling QBASIC "Please find the segment that the variable a% is stored in, and make that the current segment. Then, find the offset of the variable a% and, within that segment, read the two bytes of memory at that location and the location after it."

Since the data type of a% is INTEGER, it is exactly 2 bytes long, so the variables l% and h% are set to the two bytes that represent the INTEGER value passed to the ROL2 function. :-)

As for the actual rotation, that is handled by the two look-up tables that are initialized only once before all calls to ROL2. The shiftLeft%() table stores the value of each byte shifted left 2 bits. The bits shifted off the top end are stripped off, which is the way a "shift" differs from a "rotate". The shiftRight%() table stores the value of each byte shifted right *6* bits. The 6 right-most bits disappear, leaving only those 2 upper bits that get lost in the shiftLeft%() table.

If you had a single byte that you wanted to *rotate* left by 2 bits, then, you could simply look up that byte in both tables, and combine the two results. The shiftLeft%() table would remove the top 2 bits and shift the remaining 6 ones up against the left edge of the byte, and the shiftRight%() table would bring back those 2 bits, aligned to the right end of the table. Here is an example:

Byte value: 93
Bits: 01011101

shiftLeft%(93) = 116 = 01110100
shiftRight%(93) = 1 = 00000001

Then you OR the values together:

01110100 <-- shiftLeft%(93)
00000001 <-- shiftRight%(93)
01110101

This shows how my tables can be combined to rotate a single byte left by 2 bits. If you have a value spread across 2 bytes, the principle is the same, except instead of joining shiftLeft%() and shiftRight%() values from the same byte, you use them for adjacent bytes, so that through shiftLeft%(), the 6 bits of each byte that stay within the byte get moved to the left, and through shiftRight%(), the top 2 bits of each byte get moved into the low 2 bits of the next byte in the value. This is what the POKE statements in ROL2 do:

Code:
POKE ptr%, shiftLeft%(l%) OR shiftRight%(h%)
POKE ptr% + 1, shiftLeft%(h%) OR shiftRight%(l%)

The actual rotation -- the 2 high bits from the left of the 16-bit value ending up at the right end as the 2 low bits -- is the shiftRight%(h%) on the first POKE line.

Does this explain how the function works? :-)

Anonymous

nice explanation..

i even learned something :P
logiclrd,

Yes, very nice explanation. Thank you very much. As a matter of fact, you should write and submit a tutorial about data addressing, so everyone can benefit from your knowledge.

Back in the 1960's when I coded the IBM 360 in assembler, there were similar memory addressing considerations since addresses were divided into base + displacement, and the base address was the contents of a specified register. Somewhat similar idea to segment and offset.

I never coded x86 machines in assembler. The latest microprocessors I coded in assembler were the Motorola 6502, RCA 1802 and CDC 469.
*****
Quote:As a matter of fact, you should write and submit a tutorial about data addressing, so everyone can benefit from your knowledge.

Actually I have already done a similar sort of FAQ on another site. I think I did a better job of explaining segments and offsets in the post here, though :-) The FAQ is at:

http://www.tek-tips.com/faqs.cfm?fid=290

There are a number of other FAQs written by me, and many more written by other people, at the same site:

http://www.tek-tips.com/faq.cfm?pid=314

It has been a long time since I was active there, though :-)
Code:
declare function rot ( n as integer, a as integer, w as integer ) as integer
declare sub dorot ( n as integer, a as integer, w as integer )
declare function tostr$ ( n as integer )

function tostr$ ( n as integer )
    tostr$ = ltrim$(str$(n))
end function

sub dorot ( n as integer, a as integer, w as integer )
   print "rot(" + tostr$(n) + ", " + tostr$(a) + ", " + tostr$(w) + ") = "; tostr$(rot(n,a,w))
end sub

function rot ( n as integer, a as integer, w as integer ) as integer

    dim a2 as integer, b2 as integer
    dim mask as integer, last as integer
    dim flag as integer = 0
    dim ret as integer
    
    a2 = 2^abs(a)
    b2 = 2^(w-abs(a))
    mask = (2^w)-1
    last = 2^(w-1)
    
    if n < 0 then
        n = abs(n) or last
        flag = 1
    end if
    
    if a = 0 then
        rot = n
    elseif a < 0 then
        ret = ((n*a2) and mask) or ((n - (n and (b2-1))) / b2)
    elseif a > 0 then
        ret = ((n*b2) and mask) or ((n - (n and (a2-1))) / a2)
    end if
    
    if (flag <> 0) and ((ret and last) <> 0) then ret = -(ret and (last-1))
    
    rot = ret

end function


dorot 5, 1, 3       ' 6
dorot 5, -1, 3      ' 3
dorot 11, 2, 4      ' 14
dorot 11, -2, 4     ' 14
dorot -5, 1, 4      ' -6
dorot -5, -1, 4     ' -3
dorot &HFFFF, 4, 16 ' 65535

ok... now it handles negatives, and i've got my lefts and rights right Tongue

I think anyway... I'm having trouble concentrating...
Lithium, while your code certainly works, its performance will, I'm afraid, be quite hideous. Here is a comparison of my lookup-table version and your function:

Code:
00FB   040E    SUB ROL2 (a%)
011D   040E    DEF SEG = VARSEG(a%)
0107    **                  mov     ax,ds
011F    **                  push    ax
0120    **                  call    B$DSEG
011D   040E    ptr% = VARPTR(a%)
0125    **                  mov     ax,06h[bp]
0128    **                  mov     0ECh[bp],ax
011D   040E    l% = PEEK(ptr%)
012B    **                  mov     bx,ax
012D    **                  mov     es,b$seg%
0131    **                  es:    
0132    **                  mov     bl,[bx]
0134    **                  xor     bh,bh
0136    **                  mov     0EAh[bp],bx
011D   040E    h% = PEEK(ptr% + 1)
0139    **                  inc     ax
013A    **                  mov     bx,ax
013C    **                  mov     es,b$seg%
0140    **                  es:    
0141    **                  mov     bl,[bx]
0143    **                  xor     bh,bh
0145    **                  mov     0E8h[bp],bx
011D   040E    POKE ptr%, shiftLeft%(l%) OR shiftRight%(h%)
0148    **                  mov     si,0EAh[bp]
014B    **                  sal     si,1
014D    **                  mov     ax,SHIFTLEFT%[si]
0151    **                  mov     di,bx
0153    **                  sal     di,1
0155    **                  or      ax,SHIFTRIGHT%[di]
0159    **                  mov     bx,0ECh[bp]
015C    **                  mov     es,b$seg%
0160    **                  es:    
0161    **                  mov     [bx],al
0163   040E    POKE ptr% + 1, shiftLeft%(h%) OR shiftRight%(l%)
0163    **                  mov     si,0E8h[bp]
0166    **                  sal     si,1
0168    **                  mov     ax,SHIFTLEFT%[si]
016C    **                  mov     di,0EAh[bp]
016F    **                  sal     di,1
0171    **                  or      ax,SHIFTRIGHT%[di]
0175    **                  mov     bx,0ECh[bp]
0178    **                  inc     bx
0179    **                  mov     es,b$seg%
017D    **                  es:    
017E    **                  mov     [bx],al
0180   040E    END SUB
0180    **        I00012:   call    B$CENP

A total of 36 assembler instructions, only 2 of them CALL instructions.

Now for your albeit somewhat more powerful function:

Code:
0049   0006    FUNCTION rot (n AS INTEGER, a AS INTEGER, w AS INTEGER)
0049   0006    
0049   0006        DIM a2 AS INTEGER, b2 AS INTEGER
0049   0006        DIM mask AS INTEGER, last AS INTEGER
0049   0006        DIM flag AS INTEGER
0049   0006        DIM ret AS INTEGER
0049   0006    
0049   0006        flag = 0
0049    **                  mov     0E4h[bp],0000h
004E   0006        
004E   0006        a2 = 2 ^ ABS(a)
004E    **                  mov     si,0Ah[bp]
0051    **                  mov     ax,[si]
0053    **                  cwd    
0054    **                  xor     ax,dx
0056    **                  sub     ax,dx
0058    **                  mov     bx,ax
005A    **                  call    B$FIL2
005F    **                  int     35h
0061    **                  db      06h
0062    **                  dw      <00000040>
0064    **                  mov     0E0h[bp],bx
0067    **                  int     3Dh
0069    **                  call    B$POW4
006E    **                  int     3Bh
0070    **                  db      5Eh
0071    **                  db      0ECh
0072    **                  int     3Dh
0074   0006        b2 = 2 ^ (w - ABS(a))
0074    **                  mov     si,08h[bp]
0077    **                  mov     ax,[si]
0079    **                  mov     bx,ax
007B    **                  sub     ax,0E0h[bp]
007E    **                  call    B$FIL2
0083    **                  int     35h
0085    **                  db      06h
0086    **                  dw      <00000040>
0088    **                  mov     0DEh[bp],bx
008B    **                  int     3Dh
008D    **                  call    B$POW4
0092    **                  int     3Bh
0094    **                  db      5Eh
0095    **                  db      0EAh
0096    **                  int     3Dh
0098   0006        mask = (2 ^ w) - 1
0098    **                  mov     ax,0DEh[bp]
009B    **                  mov     bx,ax
009D    **                  call    B$FIL2
00A2    **                  int     35h
00A4    **                  db      06h
00A5    **                  dw      <00000040>
00A7    **                  int     3Dh
00A9    **                  call    B$POW4
00AE    **                  int     34h
00B0    **                  db      26h
00B1    **                  dw      <0000803F>
00B3    **                  int     3Bh
00B5    **                  db      5Eh
00B6    **                  db      0E8h
00B7    **                  int     3Dh
00BC   0006        last = 2 ^ (w - 1)
00BC    **                  mov     ax,0DEh[bp]
00BC    **                  dec     ax
00BD    **                  call    B$FIL2
00C2    **                  int     35h
00C4    **                  db      06h
00C5    **                  dw      <00000040>
00C7    **                  int     3Dh
00C9    **                  call    B$POW4
00CE    **                  int     3Bh
00D0    **                  db      5Eh
00D1    **                  db      0E6h
00D2    **                  int     3Dh
00D4   0006        
00D4   0006        IF n < 0 THEN
00D4    **                  mov     si,0Ch[bp]
00D7    **                  cmp     word ptr [si],00h
00DA    **                  jnl     I00005
00DC   0006            n = ABS(n) OR last
00DC    **                  mov     ax,[si]
00DE    **                  cwd    
00DF    **                  xor     ax,dx
00E1    **                  sub     ax,dx
00E3    **                  or      ax,0E6h[bp]
00E6    **                  mov     [si],ax
00E8   0006            flag = 1
00E8    **                  mov     0E4h[bp],0001h
00ED   0006        END IF
00ED   0006        
00ED   0006        IF a = 0 THEN
00ED    **        I00005:   mov     si,0Ah[bp]
00F0    **                  cmp     word ptr [si],00h
00F3    **                  jne     I00006
00F5   0006            rot = n
00F5    **                  mov     si,0Ch[bp]
00F8    **                  int     3Bh
00FA    **                  db      04h
00FB    **                  mov     di,06h[bp]
00FE    **                  int     35h
0100    **                  db      1Dh
0101    **                  int     3Dh
0103    **                  jmp     I00007
0106   0006        ELSEIF a < 0 THEN
0106    **        I00006:   mov     si,0Ah[bp]
0109    **                  cmp     word ptr [si],00h
010C    **                  jnl     I00008
010E   0006            ret = ((n * a2) AND mask) OR ((n - (n AND (b2 - 1))) /
                b2)
010E    **                  mov     si,0Ch[bp]
0111    **                  mov     ax,[si]
0113    **                  mov     bx,ax
0115    **                  imul    0ECh[bp]
0118    **                  and     ax,0E8h[bp]
011B    **                  cwd    
011C    **                  mov     cx,0EAh[bp]
011F    **                  dec     cx
0120    **                  and     cx,bx
0122    **                  sub     bx,cx
0124    **                  mov     0DCh[bp],dx
0127    **                  mov     0DAh[bp],ax
012A    **                  mov     ax,bx
012C    **                  call    B$FIL2
0131    **                  int     3Ah
0133    **                  db      76h
0134    **                  db      0EAh
0135    **                  call    B$FIST
013A    **                  or      ax,0DAh[bp]
013D    **                  or      dx,0DCh[bp]
0140    **                  mov     0E2h[bp],ax
0143    **                  jmp     I00007
0146   0006        ELSEIF a > 0 THEN
0146    **        I00008:   mov     si,0Ah[bp]
0149    **                  cmp     word ptr [si],00h
014C    **                  jg      $+03h
014E    **                  jmp     I00009
0151   0006            ret = ((n * b2) AND mask) OR ((n - (n AND (a2 - 1))) /
                a2)
0151    **                  mov     si,0Ch[bp]
0154    **                  mov     ax,[si]
0156    **                  mov     bx,ax
0158    **                  imul    0EAh[bp]
015B    **                  and     ax,0E8h[bp]
015E    **                  cwd    
015F    **                  mov     cx,0ECh[bp]
0162    **                  dec     cx
0163    **                  and     cx,bx
0165    **                  sub     bx,cx
0167    **                  mov     0D8h[bp],dx
016A    **                  mov     0D6h[bp],ax
016D    **                  mov     ax,bx
016F    **                  call    B$FIL2
0174    **                  int     3Ah
0176    **                  db      76h
0177    **                  db      0ECh
0178    **                  call    B$FIST
017D    **                  or      ax,0D6h[bp]
0180    **                  or      dx,0D8h[bp]
0183    **                  mov     0E2h[bp],ax
0186   0006        END IF
0186    **        I00007:
0186   0006        
0186   0006        IF (flag <> 0) AND ((ret AND last) <> 0) THEN ret = -(ret A
                ND (last - 1))
0186    **        I00009:   cmp     word ptr 0E4h[bp],00h
018A    **                  je      I00010
018C    **                  mov     ax,0E6h[bp]
018F    **                  and     ax,0E2h[bp]
0192    **                  or      ax,ax
0194    **                  je      I00010
0196    **                  mov     ax,0E6h[bp]
0199    **                  dec     ax
019A    **                  and     ax,0E2h[bp]
019D    **                  neg     ax
019F    **                  mov     0E2h[bp],ax
01A2   0006        
01A2   0006        rot = ret
01A2    **        I00010:   int     3Bh
01A4    **                  db      46h
01A5    **                  db      0E2h
01A6    **                  mov     si,06h[bp]
01A9    **                  int     35h
01AB    **                  db      1Ch
01AC    **                  int     3Dh
01AE    **        I00004:   mov     ax,06h[bp]
01B1   0006    
01B1   0006    END FUNCTION
01B1    **        I00003:   call    B$CENP

Here there are 152 instructions, 13 of which are calls, and 25 of which are software interrupts, which are like a CALL but even slower!

The problem is that through the use of '^', and division using '/' instead of '\', you have introduced floating-point math into the function. For instance, you see calls to runtime functions B$FIL2 and B$FIST. FIL2 is "load 2-byte integer, converting it into a floating-point value" (Flating point Integer Load 2-byte), and FIST is "store floating-point value as an integer" (Floating point Integer STore). The interrupts constitute QBASIC's floating-point emulation library; when QBASIC was created, processors didn't have hardware floating-point.

And unfortunately, there isn't a lot you can do about it; this is one area where QB's math capabilities are sadly lacking. While you can use '\' instead of '/' to achieve pure integer division, there is no integer version of '^'. You must resort to a look-up table if you want to do fast integer exponentiation. Fortunately, the domain of your '^' is relatively small; a table would need only a handful of entries.

So, not to be a downer, but while a function like this can be more readable, it will completely kill the performance of a program that frequently calls it.
Lithium,

I can't figure out how to test your solution, so, I'm going to ask you to do the same as I previously asked logiclrd, which is:

Write and post, a test program using your solution, that prints onto a workfile every value from -32768 tp 32766 on individual lines, and on the same line prints the resultant value which has been shifted left and rotated 2 bits.

The format for the output is:
PRINT #1,INPUT.INTEGER , RESULT.INTEGER
where #1 is the output workfile you opened.

I should then be able to take your test program, compile it, and run it producing the workfile. I'll then examine the workfile and make sure the results are correct.

Thanks.
*****
So, when rotating a positive number, is it possible for the number tobecome negative?
Pages: 1 2 3 4 5 6 7 8 9 10