Test piece for the new PowerBASIC compilers.

[hutch--]

The main fun here is the capacity to port masm code with very little modification directly into PowerBASIC.

Code Select Expand


' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

    MACRO invoke1(func,arg)
      ! push arg
      ! call func
    END MACRO

    MACRO invoke2(func,arg1,arg2)
      ! push arg2
      ! push arg1
      ! call func
    END MACRO

    MACRO invoke3(func,arg1,arg2,arg3)
      ! push arg3
      ! push arg2
      ! push arg1
      ! call func
    END MACRO

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

DECLARE FUNCTION MessageBox LIB "USER32.DLL" ALIAS "MessageBoxA" (BYVAL hWnd AS DWORD, _
                 lpText AS ASCIIZ, lpCaption AS ASCIIZ, BYVAL dwType AS DWORD) AS LONG

FUNCTION PBmain as LONG

    LOCAL ptxt as DWORD
    LOCAL ttxt as DWORD
    LOCAL txtbuf as ASCIIZ * 64
    LOCAL titbuf as ASCIIZ * 64
    LOCAL lvar as DWORD

    ptxt = VarPtr(txtbuf)
    ttxt = VarPtr(titbuf)

    txtbuf = "Title Bar Is The Length Of This String   "

    invoke1(szupper,ptxt)
    ! mov ptxt, eax

    invoke1(szlower,ptxt)
    ! mov ptxt, eax

    invoke1(StrLen,ptxt)
    ! mov lvar, eax

    invoke2(utoa,12345678,ttxt)
    ! mov ttxt, eax

    MessageBox 0,ByVal ttxt,"text",0

    mbox ptxt,ttxt

End FUNCTION

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

FASTPROC utoa
    PREFIX "! "

    push ebx
    push esi

    mov eax, [esp+12]       ; value
    mov esi, [esp+16]       ; szbuf

    cmp eax, 1000000000
    jb lb9
    add esi, 10

  nxt:
    mov ebx, &H0CCCCCCCD
    mov BYTE PTR [esi], 0
    sub esi, 1

  align 4
  stlp:
    mov ecx, eax
    mul ebx
    shr edx, 3
    mov eax, edx
    lea edx, [edx+edx*4]
    lea edx, [edx+edx-48]
    sub ecx, edx
    mov [esi], cl
    sub esi, 1
    test eax, eax
    jbe lpqt

    mov ecx, eax
    mul ebx
    shr edx, 3
    mov eax, edx
    lea edx, [edx+edx*4]
    lea edx, [edx+edx-48]
    sub ecx, edx
    mov [esi], cl
    sub esi, 1
    test eax, eax
    ja stlp

  lpqt:
    mov eax, [esp+16]
    pop esi
    pop ebx

    ret 8

  align 4
  lb1:
    add esi, 1
    jmp nxt
  lb2:
    cmp eax, 10
    jb lb1
    add esi, 2
    jmp nxt
  lb3:
    cmp eax, 100
    jb lb2
    add esi, 3
    jmp nxt
  lb4:
    cmp eax, 1000
    jb lb3
    add esi, 4
    jmp nxt
  lb5:
    cmp eax, 10000
    jb lb4
    add esi, 5
    jmp nxt
  lb6:
    cmp eax, 100000
    jb lb5
    add esi, 6
    jmp nxt
  lb7:
    cmp eax, 1000000
    jb lb6
    add esi, 7
    jmp nxt
  lb8:
    cmp eax, 10000000
    jb lb7
    add esi, 8
    jmp nxt
  lb9:
    cmp eax, 100000000
    jb lb8
    add esi, 9
    jmp nxt

    END PREFIX
END FASTPROC

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

FASTPROC txtlen
    PREFIX "! "
  ; -------------------------
  ; Simple string length algo
  ; -------------------------
    mov eax, [esp+4]
    sub eax, 1

  align 4
  lbl0:
    add eax, 1
    cmp BYTE PTR [eax], 0
    jne lbl0

    sub eax, [esp+4]
    ret 4

    END PREFIX
END FASTPROC

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

FASTPROC szupper
    PREFIX "! "

  ; -----------------------------
  ; converts string to upper case
  ; invoke szUpper,ADDR szString
  ; -----------------------------

    mov eax, [esp+4]
    dec eax

  lbl0:
    add eax, 1
    cmp BYTE PTR [eax], 0
    je lbl1
    cmp BYTE PTR [eax], "a"
    jb lbl0
    cmp BYTE PTR [eax], "z"
    ja lbl0
    sub BYTE PTR [eax], 32
    jmp lbl0
  lbl1:

    mov eax, [esp+4]

    ret 4

    END PREFIX
END FASTPROC

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

FASTPROC szlower
    PREFIX "! "

  ; -----------------------------
  ; converts string to lower case
  ; invoke szLower,ADDR szString
  ; -----------------------------

    mov eax, [esp+4]
    dec eax

  lbl0:
    add eax, 1
    cmp BYTE PTR [eax], 0
    je lbl1
    cmp BYTE PTR [eax], "A"
    jb lbl0
    cmp BYTE PTR [eax], "Z"
    ja lbl0
    add BYTE PTR [eax], 32
    jmp lbl0
  lbl1:

    mov eax, [esp+4]

    ret 4

    END PREFIX
END FASTPROC

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

FASTPROC StrLen
    PREFIX "! "

    mov     eax, [esp+4]            ; get pointer to string
    lea     edx, [eax+3]            ; pointer+3 used in the end
    push    esi
    push    edi
    mov     esi, &H80808080

  lpst:     
    mov     edi, [eax]              ; read first 4 bytes
    add     eax, 4                  ; increment pointer
    lea     ecx, [edi-&H01010101]   ; subtract 1 from each byte
    not     edi                     ; invert all bytes
    and     ecx, edi                ; and these two
    and     ecx, esi
    jnz     nxt

    mov     edi, [eax]              ; read first 4 bytes
    add     eax, 4                  ; increment pointer
    lea     ecx, [edi-&H01010101]   ; subtract 1 from each byte
    not     edi                     ; invert all bytes
    and     ecx, edi                ; and these two
    and     ecx, esi
    jnz     nxt

    mov     edi, [eax]              ; read first 4 bytes
    add     eax, 4                  ; increment pointer
    lea     ecx, [edi-&H01010101]   ; subtract 1 from each byte
    not     edi                     ; invert all bytes
    and     ecx, edi                ; and these two
    and     ecx, esi
    jnz     nxt

    mov     edi, [eax]              ; read first 4 bytes
    add     eax, 4                  ; 4 increment DWORD pointer
    lea     ecx, [edi-&H01010101]   ; subtract 1 from each byte
    not     edi                     ; invert all bytes
    and     ecx, edi                ; and these two
    and     ecx, esi
    jz      lpst                    ; no zero bytes, continue loop

  nxt:
    test    ecx, &H00008080         ; test first two bytes
    jnz     frwd
    shr     ecx, 16                 ; not in the first 2 bytes
    add     eax, 2
  frwd:
    shl     cl, 1                   ; use carry flag to avoid branch
    sbb     eax, edx                ; compute length
    pop     edi
    pop     esi

    ret     4

    END PREFIX
END FASTPROC

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤

FASTPROC mbox(ByVal ptxt as LONG,ByVal ttxt as LONG) as LONG

    ptxt = MessageBox(0,ByVal ptxt,ByVal ttxt,0)

END FASTPROC = ptxt

' ¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤