EuroAssembler Index Manual Download Source Macros


Sitemap Links Forum Tests Projects

winabi.htm
Macros
GetArg
GetArgCount
StdInput
StdOutput
TerminateProgram
WinABI
WinAPI

MS Windows x64 Application Binary Interface macros.

This library contains macros for some basic OS interactions: retrieving of command-line arguments, standard I/O, program termination, invocation of 64bit MS Windows Application Binary Interface as specified in [WinABI64].

Macro names in this 64bit library winabi.htm are identical with macros from 32bit library winapi.htm . Both versions are not expected to be included together in the same source.

This library provides two variants of macro for ABI invocation:

Choice of the variant depends on optimization criterion:

Examples of a few typical OS invocations and their emitted sizes in bytes:
Example of Windows function invocationNumber
of args
WinABI
(fast)
WinAPI
(robust)
GetCursor02820
SetArcDirection, [hDC], AD_CLOCKWISE24129
MessageBox, NULL, Text, Caption, MB_OK45542
AngleArc, [hDC], 100, 120, RCX, [StartAngle]#SS, XMM1466749
CreateFile, FileName, GENERIC_READ, FILE_SHARE_READ, \
0, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0
75944

Robust variant WinAPI is usually shorter, but it emits 191 additional bytes of runtime procedure (only once in a program), so it is profitable when we have more than twenty Windows invocations in the program. Robust variant may also spare some push/pops because it doesn't change any scratch registers.

Programming interface macros represent elegant way of interaction with operating system using only one single statement. Otherwise we would have to push or load appropriate registers with argument values in the right order, store caller-save registers, manually arrange stack alignment, call the imported function and finally restore the stack.

Both versions guarantee the proper stack alignment. They require option EUROASM CPU=X64, SIMD=SSE1.

Argument of macros WinAPI and WinABI can be SIMD register or anything pushable:

It is programmer's responsibility to provide exactly that many arguments as is specified in Function documentation.

Each argument may be suffixed with type specificator #SS or #SD (case insensitive), which signalizes that it represents floating-point value in Scalar Single or Scalar Double precision format, and that it should be therefore passed to the Function in XMM register instead of GPR.
Suffix is not necessary in 5th and higher arguments (they are passed via machine stack regardless of their type).
Suffix is not necessary with XMM register (argument passed in XMM is always assumed to contain floating-point number).

From parsing reason do not use single apostrophe ' in string literals used as macro arguments. Please prefer double quote: WinAPI MessageBox,0,="Text","Title",0 instead of WinAPI MessageBox,0,='Text','Title',0


 winabi HEAD
        INCLUDE1 winansi.htm ; Make sure that %WinANSI is assigned before WinAPI and WinABI invocation.
↑ WinAPI   Function, Argument1, Argument2,,,Lib=

Macroinstruction WinAPI invokes Function exported from MS Windows by [WindowsAPI]   in the calling convention compatible with [WinABI64].

This is the robust variant of Windows function invocation which allows to use arbitrary SIMD or GPR as parameter and preserves the original value of all registers (except for RAX and XMM0). For the fast variant see WinABI below.

The macro is similar to FastCall's Invoke with these differences:

Example of stack layout for Function with 6 arguments
WinAPI Function, Arg1,Arg2,Arg3,Arg4,Arg5,Arg6 ┌────────┐ ┐ │ Arg6 │ │ ├────────┤ │ │ Arg5 │ │ ├────────┤ │ │ Arg4 │ │ ├────────┤ │ │ Arg3 │ ├─Frame of WinAPI@RT. ├────────┤ │ │ Arg2 │ │ ├────────┤ │ │ Arg1 │ │ ├────────┤ │ │NrOfArg │ │ NrOfArg=6 in this example. ├────────┤ ┘ │RET(@RT)│ ├────────┤ ┐ │ RSI │ │ ├────────┤ │ │ RDI │ │ ├────────┤ │ │ R12 │ │ ├────────┤ │ │ RCX │ │ ├────────┤ │ │ RDX │ │ ├────────┤ │ │ R8 │ │ ├────────┤ │ │ R9 │ │ ├────────┤ │ │ R10 │ │ ├────────┤ │ │ R11 │ ├─Local stack ├────────┤ │ of WinAPI@RT. │ XMM1L │ │ ├────────┤ │ │ XMM2L │ │ ├────────┤ │ │ XMM3L │ │ ├────────┤ │ │ XMM4L │ │ ├────────┤ │ │ XMM5L │ │ ├────────┤ │ ┐ │(align) │ │ ├──────Only present if RSP is OWORD-unaligned. ╞════════╡ ┘ ┘ ─┐ │ Arg6 │ │ ├────────┤ │ │ Arg5 │ │ ╞════════╡ ┐ │ │ Arg4 │ │ │ ├────────┤ │ ├─Frame of Function. │ Arg3 │ │ │ ╞════════╡ ├Shadow │ │ Arg2 │ │ space │ ├────────┤ │ │ │ Arg1 │ │ │ ╞════════╡ ┘ ─┘ <══ RSP is OWORD-aligned here. │RET(API)│ └────────┘
Input
Function is the name of invoked WinAPI function. Ambiguous functions, which have both ANSI and WIDE variant, may be specified with or without explicit suffix A or W.
Function may also be provided as a GPR (other than RAX) with RVA of the function (pointer to its thunk in [.idata]).
Argument*

Although Windows ABI specifies fastcall convention with floating-point parameters %1..%4 delivered in XMM0, XMM1, XMM2, XMM3, and with parameters %1..%4 of all other types delivered in RCX, RDX, R8, R9, arguments of this robust WinAPI macro may be supplied in those registers too in arbitrary order, for instance WinAPI MessageBox,RDX,R8,R8,MB_OK.

Argument can be anything which is allowed as an operand of machine instruction PUSH, i.e. 64bit register, segment register, pointer to memory variable or immediate integer 32bit numeric value (which will be sign-extended to 64 bits by CPU at run-time).
Argument can also be a SIMD register (XMM0..XMM31), from which only the lower QWORD will be passed to the called function.

Zero or more arguments may follow the function name. It is programmer's responsibility to provide exactly that many arguments as is specified in Function documentation.

Floating-point specificator-suffix #SS or #SD may be appended to any argument for compatibility with macros WinABI and invoke . Nevertheless, presence of this prefix is irrelevant, because the robust macro WinAPI provides the first four arguments simultaneously in SIMD and GP registers anyway, no matter if they are float or integer.
Lib= is the name of dynamic linked library (quoted or unquoted, always without path) which exports the invoked Function. This parameter may be empty or omitted
Output
Rflags, RAX, XMM0 are set as returned from the invoked Function.
All other XMM and GPR are preserved, including the lower 64bits of scratch registers XMM1..XMM5, RCX, RDX, R8..R11.
Example
WinAPI AngleArc, \ Invokation of a graphic function with 6 parameters: [hDC], \ Handle of device context. 100, \ X-coordinate of circle's center as immediate integer. 120, \ Y-coordinate of circle's center as immediate integer. RCX, \ Circle's radius as integer in GPR. [StartAngle], \ Arc's start angle as single-precision FP in memory (StartAngle:DD 45.0). XMM4, \ Arc's sweep angle as single-precision FP in XMM (MOVSD XMM4,=[DD 22.5]). Lib=Gdi32.dll ; Documented as AngleArc.
See also
Fast variant WinABI,
32bit version WinAPI in winapi.htm.
WinAPI %MACRO Function, Argument1, Argument2,,, Lib=
  %ArgNr %SETA %#                  ; Start with the last ordinal operand.
  %WHILE %ArgNr > 1
    %Arg %SET %*{%ArgNr}
    %ArgNr %SETA %ArgNr - 1        ; %ArgNr is now the ordinal argument number ..5,4,3,2,1.
    %IF '%Arg[%&-2..%&-1]' == '#S' ; If suffix #SS or #SD is present,
        %Arg %SET %Arg[1..%&-3]    ;   remove it from the argument and ignore.
    %ENDIF
 s1 %IF TYPE#(SEGMENT#(%Arg))='N'  ; Nonrelocable (scalar) argument.
   x1 %IF REGTYPE#(%Arg) = 'X'
        SUB RSP,8
        MOVQ [RSP],%Arg            ; Pseudo"push" the lower half of SIMD register.
      %ELSE x1                     ; Argument is GPR, immediate or [m64].
        PUSHQ %Arg
      %ENDIF x1
    %ELSE s1                       ; Argument needs relocation.
   m1 %IF '%Arg[1]' === '['        ; Argument is m64, e.g. [RelocSymbol+RSI].
         PUSHQ %Arg
      %ELSE m1
         LEA RAX,[%Arg],ADDR=ABS
         PUSH RAX                  ; Borrow RAX for pushing pointers.
      %ENDIF m1
    %ENDIF s1
  %ENDWHILE
  PUSHQ %# - 1                     ; Push the number of Function arguments.
r %IF REGTYPE#(%Function) = 'Q'    ; Test if the Function is specified in r64.
    %IF '%Function' == 'RAX'
      %ERROR ID=5957,'WinAPI function cannot be supplied in RAX.'
    %ENDIF
    MOV RAX,%Function
  %ELSE r                          ; The Function is specified by name.
    %suffix %SET                   ; First assume there is no A|W suffix.
 fn %FOR %WinANSI                  ; Examine if Function is on the list %WinANSI.
      %IF '%fn' === '%Function'
        %suffix %SETC ('W' & (%^UNICODE)) + ('A' & ~(%^UNICODE))
        %EXITFOR fn                ; No need for further investigation of the rest of the list.
      %ENDIF
    %ENDFOR fn                     ; %suffix is now A or W or empty.
    IMPORT %Function%suffix, Lib=%Lib
    LEA RAX,[%Function%suffix],ADDR=ABS ; RVA of the Function (pointer to its thunk in [.idata]).
  %ENDIF r
  CALL WinAPI@RT                   ; Macro continues with the runtime subroutine, which is expanded only once in program.
WinAPI@RT PROC1                    ; RSP points to the Return_addr, NrOfArg, Arg1, Arg2, ...
       PUSH RSI,RDI,R12            ; Calee-save registers used by WinAPI@RT procedure.
       PUSH RCX,RDX,R8,R9,R10,R11  ; Robust version preserves scratch GP registers.
       MOVQ RDX,XMM1
       MOVQ  R8,XMM2
       MOVQ  R9,XMM3
       MOVQ R10,XMM4
       MOVQ R11,XMM5
       PUSH RDX,R8,R9,R10,R11      ; Robust version preserves scratch SIMD registers.
       MOV ECX,[RSP+15*8]          ; Number of Function arguments.
       LEA RSI,[RSP+16*8]          ; Pointer to %Arg1 in WinAPI@RT stack frame.
       CMP ECX,4                   ; Number of arguments is 0|1|2|3|4|5|6...
       JAE .20:
       MOV CL,4                    ; Number is saturated to 4|4|4|4|4|5|6...
 .20:  MOV R12,RSP                 ; Save (perhaps unaligned) RSP to callee-preserved register.
       ; Align stack pointer as dictated by ABI.
       MOV EDX,ECX                 ; Saturated number of operands (4,5,6,,,).
       SHL EDX,3                   ; RDX bit 3 is set if saturated number of arguments is odd (5,7,9,,).
       XOR EDX,ESP                 ; RDX will be 8 when number of arguments is even and RSP is OWORD unaligned,
       AND EDX,0000_1000b          ;   or when it's odd and RSP is already OWORD aligned. Otherwise RDX=0.
       SUB RSP,RDX
       ; Copy ECX arguments from RSI to the callee's shadow space.
       MOV EDX,ECX
       SHL EDX,3
       SUB RSP,RDX                 ; Make Function frame (shadow space + possible other arguments).
       MOV RDI,RSP                 ; RSP is OWORD aligned at this moment.
       CLD
       REP MOVSQ
       ; Load first four arguments to GP registers.
       MOVQ RCX,[RSP+00]
       MOVQ RDX,[RSP+08]
       MOVQ R8, [RSP+16]
       MOVQ R9, [RSP+24]
       ; Copy first four arguments to SIMD registers (for the case they were floating-point).
       MOVQ XMM0,RCX
       MOVQ XMM1,RDX
       MOVQ XMM2,R8
       MOVQ XMM3,R9
       CALL RAX                    ; Call the Function.
       MOV RSP,R12                 ; Discard Function frame plus possible stack-alignment stuff.
       POP R11,R10,R9,R8,RDX
       MOVQ XMM5,R11
       MOVQ XMM4,R10
       MOVQ XMM3,R9
       MOVQ XMM2,R8
       MOVQ XMM1,RDX               ; Restore SIMD scratch registers.
       POP R11,R10,R9,R8,RDX,RCX   ; Restore GP scratch registers.
       POP R12,RDI,RSI             ; Restore used callee-save registers.
       RET
      ENDP1 WinAPI@RT
    LEA RSP,[RSP + 8 * %#]         ; Restore stack to equilibrum, preserving Rflags.
 %ENDMACRO WinAPI
↑ WinABI   Function, Argument1, Argument2,,,Lib=

Macroinstruction WinABI invokes Function exported from MS Windows by [WindowsAPI] in the calling convention which conforms with [WinABI64] in 64bit mode.

This is the fast variant of Windows function invocation which does not use runtime subprocedure to preserve the contents of scratch registers. For the robust variant see WinAPI above.

The macro is similar to FastCall's Invoke with two minor differences:

FastCall functions in MS Windows do not keep the original contents of Rflags, RAX, RCX, RDX, R8..R11, XMM0..XMM5.
They expect and keep Direction Flag on zero.

ABI specification requires that stack is OWORD-aligned at the moment when CALL Function instruction is just about to begin. This means that when the CALL has just been executed and RIP points to the first instruction of called Function, RSP is OWORD-misaligned by QWORD, in other words its least significant bits are 1000b. This is automatically arranged by both fast and robust variants of ABI invocation macros, and stack pointer is returned to its original value when the macro ends. In WinABI this is achieved by pushing one or two copies of original RSP contents in the beginning. The number of pushed copies depends on RSP alignment at run-time. Of course RSP must always be at least QWORD-aligned, which is general requirement in 64bit programming.

Stack frame management in this fast variant WinABI is identical with 64bit macro Invoke in the library fastcall.htm, see the Example.

Input
Function is the name of invoked WinABI function. Ambiguous functions, which have both ANSI and WIDE variant, may be specified with or without explicit suffix A or W.
Function may also be provided in a GPR (other than RAX,RCX,RDX,R8,R9) with VA of the function (pointer to its thunk in [.idata]).
Argument* are parameters passed to the Function. See the common Argument specifications above.
In this fast variant may registers RAX, RCX, RDX, R8, R9, XMM0..XMM3 not be used as macro arguments, because they are being overwritten in prologue. Or they must be used in the exact ABI-specified order, e.g. WinABI Function, RCX, XMM1, R8, XMM3.
Lib= is the name of dynamic linked library (quoted or unquoted, always without path) which exports the invoked Function. This parameter may be empty or omitted
Output
Rflags, RAX, XMM0 provide the result value of Function (return registers).
RBX,RBP,RSI,RDI,R12..R15,XMM6..XMM15 keep their previous contents (callee-saved),
RCX,RDX,R8..R11,XMM1..XMM5 are undefined (scratch registers),
Example
; GetEnvironmentVariable ("PATH",PathBuffer,MAX_PATH_SIZE) // C syntax. WinABI GetEnvironmentVariable,="PATH",PathBuffer,MAX_PATH_SIZE ; €ASM syntax.
See also
robust variant WinAPI and 32bit version WinAPI in winapi.htm.
WinABI %MACRO Function, Argument1, Argument2,,, Lib=
  PUSH RSP                       ; Store original stack pointer value (equilibrum).
  TEST SPL,1000b                 ; Test stack OWORD alignment at run-time.
  %IF %# & 1b || %# <= 5         ;>If the number of Function arguments is 0,1,2,3,4,6,8,10,,
     JZ .WinABI%.:               ;   store 2nd copy of equilibrum when RSP is OWORD-unaligned.
  %ELSE                          ; If the number of arguments is 5,7,9,11,,,
     JNZ .WinABI%.:              ;   store 2nd copy of equilibrum when RSP is OWORD-aligned.
  %ENDIF
  PUSH RSP                       ; Store and update 2nd copy of original RSP (equilibrum).
  ADDQ [RSP],8                   ; Those two instructions aren't executed if RSP was properly aligned.
.WinABI%.:
  %GPR  %SET RCX,RDX,R8,R9       ; Declare order of registers used for first four arguments.
  %SIMD %SET XMM0,XMM1,XMM2,XMM3
  %ArgNr %SETA %#                ; Number of arguments + 1.
  %WHILE %ArgNr > 1              ; Pass all arguments, start with the last one.
    %Arg %SET %*{%ArgNr}
    %ArgNr %SETA %ArgNr - 1      ; %ArgNr is now the ordinal argument number ..5,4,3,2,1.
    %IF '%Arg[%&-2..%&-1]'=='#S' ; If suffix #SS or #SD is present.
      %suffix %SET %Arg[%&-1..%&]; %suffix is now SS or SD.
      %Arg %SET %Arg[1..%&-3]    ; Remove the suffix from %Arg.
    %ELSE
      %suffix %SET Q             ; Otherwise %suffix is Q (use MOVQ instead of MOVSS or MOVSD).
    %ENDIF
 a5 %IF %ArgNr > 4               ; Argument %5 and higher is passed by stack.
   s5 %IF TYPE#(SEGMENT#(%Arg))='N' ; Nonrelocable (scalar) argument.
     x5 %IF REGTYPE#(%Arg)='X'
          SUB RSP,8              ; Pseudo"push" XMM on stack.
          MOV%suffix [RSP],%Arg
        %ELSE x5
          PUSHQ %Arg             ; Other non-XMM scalar argument PUSH as is.
        %ENDIF x5
      %ELSE s5                   ; Argument needs relocation.
     m5 %IF '%Arg[1]' === '['    ; Argument is m64, e.g. [RelocSymbol+RSI].
          PUSHQ %Arg
        %ELSE M5                 ; Otherwise it is relocable offset (pointer).
          LEA RAX,[%Arg],ADDR=ABS
          PUSH RAX               ; Borrow RAX for pushing pointers.
        %ENDIF m5
      %ENDIF s5
    %ELSE a5                      ; Argument %1..%4 is passed in GPR or SIMD register.
   s4 %IF TYPE#(SEGMENT#(%Arg))='N' ; Nonrelocable (scalar) argument or register.
     q4 %IF REGTYPE#(%Arg) = 'Q'  ; Argument is GPR.
       i4 %IF '%suffix'==='Q'     ; Argument is integer, it goes to GPR.
            %IF '%GPR{%ArgNr}' !== '%Arg' ; Emit only if it's not already there.
              MOVQ %GPR{%ArgNr},%Arg
            %ENDIF
          %ELSE i4                ; Argument is float, it goes to SIMD.
            MOVQ %SIMD{%ArgNr},%Arg
          %ENDIF i4
        %ELSE q4                  ; Argument is not GPR.
       x4 %IF REGTYPE#(%Arg)='X'  ; Argument is SIMD.
            %IF '%SIMD{%ArgNr}' !== '%Arg' ; Emit only if it's not already there.
              MOV%suffix %SIMD{%ArgNr},%Arg
            %ENDIF
          %ELSE x4                ; Nonrelocable argument is not SIMD neither GPR.
         m4 %IF 'Arg[1]' === '['  ; Argument is m64, e.g. [RBP+8] or [RBP+8]#SS.
           i3 %IF '%suffix' === 'Q' ; Argument is integer, it goes to GPR.
                MOVQ %GPR{%ArgNr},%Arg
              %ELSE i3
                MOV%suffix %SIMD{%ArgNr},%Arg ; Argument is float, it goes to SIMD.
              %ENDIF i3
            %ELSE m4              ; Argument is immediate scalar.
              %IF '%suffix' !=== 'Q'
                %ERROR ID=5958,"Floating-point immediate argument is not supported."
              %ENDIF
              MOVQ %GPR{%ArgNr},%Arg
            %ENDIF m4
          %ENDIF x4
        %ENDIF q4
      %ELSE s4                     ; Argument needs relocation.
     m3 %IF '%Arg[1]' === '['      ; Argument is m64, e.g. [RelocSymbol+RSI].
        i2 %IF '%suffix' === 'Q'   ; Argument is integer, it goes to GPR.
              MOVQ %GPR{%ArgNr},%Arg
           %ELSE i2
              MOV%suffix %SIMD{%ArgNr},%Arg
           %ENDIF i2
        %ELSE m3                   ; Argument is immediate pointer.
        i1 %IF '%suffix' === 'Q'   ; Argument is integer, it goes to GPR.
             LEA %GPR{%ArgNr},[%Arg],ADDR=ABS
           %ELSE i1
             %ERROR ID=5958,"Floating-point immediate argument is not supported."
             LEA RAX,[%Arg],ADDR=ABS
             MOVQ %SIMD{%ArgNr},RAX
           %ENDIF i1
        %ENDIF m3
      %ENDIF s4
    %ENDIF a5
  %ENDWHILE
  SUB RSP,4*8                      ; Make room for shadow space. RSP is now OWORD-aligned.
  reg %IF TYPE# %Function = 'R'; Test if the Function is specified in register.
        %IF "%Function"=="RAX"||"%Function"=="RCX"||"%Function"=="RDX"||"%Function"=="R8"||"%Function"=="R9"
          %ERROR ID=5956,'WinABI function cannot be supplied in scratch register %Function.'
          %EXITMACRO WinABI
        %ENDIF
        CALL %Function
      %ELSE reg                    ; The Function is specified by its name.
        %suffix %SET               ; First assume there is no A|W suffix.
        fn %FOR %WinANSI           ; Examine if Function is on the list %WinANSI.
             %IF '%fn' === '%Function'
               %suffix %SETC ('W' & (%^UNICODE)) + ('A' & ~(%^UNICODE))
               %EXITFOR fn         ; No need for further examination of the list.
             %ENDIF
           %ENDFOR fn              ; %suffix is now A or W or empty.
        IMPORT %Function%suffix, Lib=%Lib
        CALL %Function%suffix      ; Actual calling of ABI function.
      %ENDIF reg
      %IF %# > 5
        %ArgNr %SETA %# - 1
      %ELSE
        %ArgNr %SETA 4
      %ENDIF
      LEA RSP,[RSP+8*%ArgNr]       ; Let RSP skip all pushed arguments, keeping Rflags,
      POP RSP                      ;  and restore RSP to equilibrum from 1st or 2nd copy.
   %ENDMACRO WinABI
↑ GetArgCount
counts arguments provided on the command line of the executed program. Arguments may be separated with unquoted spaces or commas. Multiple white spaces are treated like a single space. Comma-separated empty arguments are counted, too. Single apostrophe cannot be used as a quote.
Input
is taken from the command line which launched the program.
Output
CF=0
RAX=number of arguments on the command line which launched the program.
Error
CF=1 if odd number of quotes detected.
See also
GetArg
Example
All examples of the command lines below will return ArgCount=4.
Program.exe arg1 arg2 arg3 arg4 Program.exe arg1,arg2, ,arg4 Program.exe , , , , , Program.exe arg1, "arg2,arg2" arg3 arg4
GetArgCount %MACRO
       CALL GetArgCount@RT
GetArgCount@RT PROC1
     PUSH RCX,RDX,R8,R9,R10,R11
      MOV RBP,RSP
   %GetArgWithin    %SETA 1 ; Boolean parsing flags will be kept in DL.
   %GetArgInQuotes  %SETA 2
   %GetArgCommaTerm %SETA 4
      WinAPI GetCommandLineA
      MOV RSI,RAX ; RSI now points to the entire command-line ANSI zero-terminated string.
      SUB RCX,RCX ; RCX will keep the ordinal number of parsed cmdline argument.
      SUB DL,DL   ; Flags in DL will be used as a parsing status register.
      TEST ESI,ESI
      JZ .80: ; If API returned FALSE.
      DEC RCX
 .10: LODSB
      CMP AL,' '
      JBE .30:
      CMP AL,','
      JE .30:
      AND DL,~%GetArgCommaTerm
      CMP AL,'"'
      JNE .20:
      XOR DL,%GetArgInQuotes
 .20: TEST DL,%GetArgWithin
      JNZ .10:
      OR DL,%GetArgWithin
      INC RCX
      JMP .10:
 .30: TEST DL,%GetArgInQuotes
      JZ .40:
      CMP AL,0
      JNE .10:
      JMP .80:
 .40: TEST DL,%GetArgWithin
      JZ .50:
      AND DL,~(%GetArgWithin|%GetArgCommaTerm)
      CMP AL,','
      JNE .70:
      OR DL,%GetArgCommaTerm
      JMP .70:
 .50: CMP AL,0
      JE .80:
      CMP AL,','
      JNE .10:
      TEST DL,%GetArgCommaTerm
      JNZ .60:
      OR DL,%GetArgCommaTerm
      JMP .10:
 .60: INC RCX
 .70: CMP AL,0
      JNE .10:
 .80: TEST DL,%GetArgInQuotes
      JZ .90:
      STC ; If premature end of command line.
 .90: MOV RAX,RCX
     POP R11,R10,R9,R8,RDX,RCX
     RET
   ENDPROC1 GetArgCount@RT
  %ENDMACRO GetArgCount
↑ GetArg   ArgNumber

Macro GetArg retrieves ArgNumber-th parameter provided on command line.
Parameters on the command line may be separated with unquoted white spaces or commas. Single aphostrophe cannot be used as quote.
Macro returnes the executable name itself when ArgNumber is 0. It is taken verbatim from the console window or, if launched from Explorer, it may be expanded to a full pathname.

The returned argument is not zero terminated and it is not writable. Make a copy in local memory if you need to modify it. Quotes surrounding the argument are returned, too.

Value of EUROASM UNICODE= option specifies whether the returned string will be ANSI or WIDE.

Input
ArgNumber (64bit register or memory or immediate number) is ordinal number of the required parameter. The 0-th parameter is the executable file name itself.
Output
CF=0,
RSI is pointer to the first character of argument,
RCX is the size of argument in bytes.
Error
CF=1 if odd number of quotes or if requested argument was not provided.
RSI=RCX=0
Example
GetArg 1 ; Assume that our program should specify a filename. JC .BadArgument: ; Report error if no file was provided. StripQuotes RSI,RCX ; Get rid of quotes if they were used. MOV RDI,InputFileName$ ; Room for the filename. REP MOVSB ; Copy the filename. SUB AL,AL STOSB ; Zero terminate the string.
GetArg %MACRO ArgNumber
          PUSHQ %ArgNumber
          %IF %^UNICODE
             CALL GetArgW@RT
 GetArgW@RT PROC1
     PUSHQ RAX,RDX,R8,R9,R10,R11
 %GetArgNumber    %SET RSP+56
 %GetArgWithin    %SETA 1 ; Parsing within argument string. Boolean flags will be kept in DL.
 %GetArgInQuotes  %SETA 2 ; Parsing within quoted argument string.
 %GetArgCommaTerm %SETA 4 ; Previous argument was comma-terminated.
      WinAPI GetCommandLineW
      MOV RSI,RAX ; RSI now points to the entire command-line WIDE zero-terminated string.
      SUB RCX,RCX ; RCX will keep the ordinal number of parsed cmdline argument.
      SUB R8,R8   ; R8 will be pointer to argument.
      SUB R9,R9   ; R9 will be pointer to the end of argument.
      SUB DL,DL   ; DL will be used as a parsing flag register.
      CMP RSI,R8  ; Is the pointer valid?
      JZ .80      ; If API returned FALSE, abort with CF.
      DEC RCX     ; This first argument has ordinal 0 (executable name).
      MOV R8,RSI
 .10: LODSW       ; Parse the next character.
      CMP AX,' '
      JBE .30
      CMP AX,','
      JE .30:
      AND DL,~%GetArgCommaTerm
      CMP AX,'"'
      JNE .20:
      XOR DL,%GetArgInQuotes
 .20: TEST DL,%GetArgWithin
      JNZ .10:
      OR DL,%GetArgWithin
      INC RCX        ; Started to parse RCX-th argument now.
      LEA R8,[RSI-2] ; Remember in R8 where this argument begins.
      JMP .10:
 .30: TEST DL,%GetArgInQuotes
      JZ .40:
      CMP AX,0
      JNE .10:
      JMP .80:
 .40: TEST DL,%GetArgWithin
      JZ .50:
      AND DL,~(%GetArgWithin|%GetArgCommaTerm) ; Character in AX (comma or space or 0) terminates the argument.
      LEA R9,[RSI-2] ; End of argument.
      CMP AX,','
      JNE .70:
      OR DL,%GetArgCommaTerm
      JMP .70:
 .50: CMP AX,0
      JE .80:
      CMP AX,','
      JNE .10:
      TEST DL,%GetArgCommaTerm
      JNZ .60:
      OR DL,%GetArgCommaTerm
      JMP .10:
 .60: LEA R9,[RSI-2]   ; Pointer to the end of argument.
      INC RCX
 .70: CMP RCX,[%GetArgNumber] ; Have we reached the desired argument?
      JE .90:
      CMP AX,0
      JNE .10:
 .80: STC              ; If premature end of command line.
 .90: PUSHF            ; Temporarily save CF.
       MOV RCX,R9      ; Return string R8..R9 as RSI,RCX.
       MOV RSI,R8
       JNC .95:
       MOV R8,RCX      ; Force RCX=0 on error.
 .95:  SUB RCX,R8
      POPF             ; Restore CF.
     POP R11,R10,R9,R8,RDX,RAX
     RET 8
   ENDPROC1 GetArgW@RT
          %ELSE        ; It not %^UNICODE.
            CALL GetArgA@RT
 GetArgA@RT PROC1
     PUSH  RAX,RDX,R8,R9,R10,R11
 %GetArgNumber    %SET RSP+56
 %GetArgWithin    %SETA 1 ; Parsing within argument string. Boolean flags will be kept in DL.
 %GetArgInQuotes  %SETA 2 ; Parsing within quoted argument string.
 %GetArgCommaTerm %SETA 4 ; Previous argument was comma-terminated.
      WinAPI GetCommandLineA
      MOV RSI,RAX ; RSI now points to the entire command-line ANSI zero-terminated string.
      SUB RCX,RCX ; RCX will keep the ordinal number of parsed cmdline argument.
      SUB R8,R8   ; R8 will be pointer to argument.
      SUB R9,R9   ; R9 will be pointer to the end of argument.
      SUB DL,DL   ; DL will be used as a parsing flag register.
      CMP RSI,R8  ; Is the pointer valid?
      JZ .80      ; If API returned FALSE, abort with CF.
      DEC RCX     ; This first argument has ordinal 0 (executable name).
 .10: LODSB       ; Parse the next character.
      CMP AL,' '
      JBE .30:
      CMP AL,','
      JE .30:
      AND DL,~%GetArgCommaTerm
      CMP AL,'"'
      JNE .20:
      XOR DL,%GetArgInQuotes
 .20: TEST DL,%GetArgWithin
      JNZ .10:
      OR DL,%GetArgWithin
      INC RCX        ; Started to parse RCX-th argument now.
      LEA R8,[RSI-1] ; Remember in R8 where this argument begins.
      JMP .10:
 .30: TEST DL,%GetArgInQuotes
      JZ .40:
      CMP AL,0
      JNE .10:
      JMP .80:       ; Abort if the closing quote is missing.
 .40: TEST DL,%GetArgWithin
      JZ .50:
      AND DL,~(%GetArgWithin|%GetArgCommaTerm) ; Character in AL (comma or space or 0) terminates the argument.
      LEA R9,[RSI-1] ; End of argument.
      CMP AL,','
      JNE .70:
      OR DL,%GetArgCommaTerm
      JMP .70:
 .50: CMP AL,0
      JE .80:
      CMP AL,','
      JNE .10:
      TEST DL,%GetArgCommaTerm
      JNZ .60:
      OR DL,%GetArgCommaTerm
      JMP .10:
 .60: LEA R9,[RSI-1]   ; Pointer to the end of argument.
      INC RCX
 .70: CMP RCX,[%GetArgNumber] ; Have we reached the desired argument?
      JE .90:
      CMP AL,0
      JNE .10:
 .80: STC              ; If premature end of command line.
 .90: PUSHF            ; Temporarily save CF.
       MOV RCX,R9      ; Return string R8..R9 as RSI,RCX.
       MOV RSI,R8
       JNC .95:
       MOV R8,RCX      ; Force RCX=0 on error.
 .95:  SUB RCX,R8
      POPF             ; Restore CF.
     POP R11,R10,R9,R8,RDX,RAX
     RET 8
  ENDPROC1 GetArgA@RT
 %ENDIF
%ENDMACRO GetArg
↑ StdOutput String1, String2,,, Size=-1, Handle=-11, Eol=No, Console=No, Unicode=%^UNICODE

Macro StdOutput writes one or more concatenated strings to the standard output or to other equipment specified with the Handle identifier.

Strings are either zero-terminated, or the keyword Size= must specify its size in bytes. The terminating NUL character is never written.

If keyword Eol=Yes, macro writes CR+LF after all strings.

One of four possible runtime subprocedures is selected to emit, depending on the chosen ANSI/WIDE and File/Console options.
Input
StringX is pointer to ANSI or WIDE string.
Size=-1 is the maximal possible string size in bytes. If its left to -1 (default), strings must be zero-terminated. This parameter applies to all ordinal operads.
Handle=-11 is the Windows standard handle identifier. Possible output values are defined in winscon.htm: Eol=No. If Yes, two additional characters CR and LF will be written on output after all strings have been written.
Console=No (or Yes) is boolean specification whether if the macro should use WinAPI function WriteFile or WriteConsole.
Output of WriteFile (default) is redirectable, but it writes WIDE string as is; in OEM console are the UTF-16 encoded characters displayed as interlaced.
Output produced by WriteConsole (when Console=Yes) cannot be redirected by command-line operator > but it accepts WIDE Unicode strings and displays the text in TrueType console properly, including non-English characters.
Unicode= %^UNICODE is boolean specification whether the Strings are in WIDE (UTF-16) encoding.
Output
CF=0
Error
CF=1 if not all characters were written or if Handle was invalid.
Example
StdOutput Message, Eol=Yes StdOutput Eol=Yes ; Write new line (CR+LF) only. StdOutput ="Error writing to file ",FileName, Handle=STD_ERROR_HANDLE
StdOutput %MACRO  String1,String2,,,Size=-1, Handle=-11, Eol=No, Unicode=%^UNICODE, Console=No
     %IF %Unicode ; WIDE variant.
       %StdOutputRT %SET StdOutputW
     %ELSE        ; ANSI variant.
       %StdOutputRT %SET StdOutputA
     %ENDIF
     %IF "%Console[1]" == "N" ; WriteFile variant.
       %StdOutputRT %SET %StdOutputRT[]F@RT
     %ELSE                    ; WriteConsole variant.
       %StdOutputRT %SET %StdOutputRT[]C@RT
     %ENDIF ; %StdOutputRT is now the name of runtime PROC1.
OpNr %FOR 1..%#, STEP=1
       PUSHQ %Handle, %Size, %1
       CALL %StdOutputRT
       %SHIFT 1  ; The next string to output.
     %ENDFOR OpNr
     %IF "%Eol[1]"!=="N"
       %IF %Unicode ; Write EOL in WIDE variant.
         PUSHQ %Handle, 4, =D(0x000A000D)
         CALL %StdOutputRT
       %ELSE        ; Write EOL in ANSI variant.
         PUSHQ %Handle, 2, =W(0x0A0D)
         CALL %StdOutputRT
       %ENDIF
     %ENDIF

WC   %IF "%StdOutputRT" === "StdOutputWC@RT"
StdOutputWC@RT:: PROC1 ; WIDE Console variant.
        PUSHQ RAX,RCX,RDX,R8,R9,R10,R11
         %StdOutputHandle %SET RSP+80
         %StdOutputSize   %SET RSP+72
         %StdOutputString %SET RSP+64
         MOV RCX,[%StdOutputHandle]
         WinABI GetStdHandle,RCX ; Output handle identifier.
         MOV R10,RAX ; Save the (redirected) handle to R10.
         INC RAX     ; Test on INVALID_HANDLE_VALUE (-1).
         STC
         JZ .90: ; Abort with CF when INVALID_HANDLE_VALUE.
         MOV RDI,[%StdOutputString] ; String pointer.
         MOV RCX,[%StdOutputSize] ; String maximal size.
         SUB EAX,EAX
         SAR ECX,1   ; Convert size in bytes to characters.
         MOV RDX,RDI  ; Remember start of string in RDX.
         REPNE SCASW ; Find the end of string.
         JNE .10:
         SUB RDI,2   ; Skip the NUL character.
   .10:  SUB RDI,RDX ; RDI is now string size in bytes.
         PUSH R9     ; Make room for the written-size DWORD.
          MOV R9,RSP
          SHR EDI,1  ; RDI is now string size in characters.
          WinABI WriteConsoleW,R10,RDX,RDI,R9,0
         POP R9
         CMP R9,RDI  ; Set CF if not all characters were written.
   .90: POP R11,R10,R9,R8,RDX,RCX,RAX
        RET 3*8
      ENDP1 StdOutputWC@RT::
     %ENDIF WC

WF   %IF "%StdOutputRT" === "StdOutputWF@RT"
StdOutputWF@RT:: PROC1 ; WIDE File variant.
       PUSHQ RAX,RCX,RDX,R8,R9,R10,R11
         %StdOutputHandle %SET RSP+80
         %StdOutputSize   %SET RSP+72
         %StdOutputString %SET RSP+64
         MOV RCX,[%StdOutputHandle]
         WinABI GetStdHandle,RCX ; Output handle identifier.
         MOV R10,RAX ; Save the (redirected) handle to R10.
         INC RAX     ; Test on INVALID_HANDLE_VALUE (-1).
         STC
         JZ .90: ; Abort with CF when INVALID_HANDLE_VALUE.
         MOV RDI,[%StdOutputString] ; String pointer.
         MOV RCX,[%StdOutputSize] ; String maximal size.
         SUB EAX,EAX
         SAR RCX,1   ; Convert size in bytes to characters.
         MOV RDX,RDI  ; Remember start of string in RDX.
         REPNE SCASW ; Find the end of string.
         JNE .10:
         SUB RDI,2   ; Skip the NUL character.
   .10:  SUB RDI,RDX ; RDI is now string size in bytes.
         PUSH R9     ; Make room for the written-size DWORD.
          MOV R9,RSP
          WinABI WriteFile,R10,RDX,RDI,R9,0
         POP R9
         CMP R9,RDI  ; Set CF if not all characters were written.
   .90: POP R11,R10,R9,R8,RDX,RCX,RAX
        RET 3*8
      ENDP1 StdOutputWF@RT::
     %ENDIF WF

AC   %IF "%StdOutputRT" === "StdOutputAC@RT"
StdOutputAC@RT:: PROC1 ; ANSI Console variant.
        PUSHQ RAX,RCX,RDX,R8,R9,R10,R11
         %StdOutputHandle %SET RSP+80
         %StdOutputSize   %SET RSP+72
         %StdOutputString %SET RSP+64
         MOV RCX,[%StdOutputHandle]
         WinABI GetStdHandle,RCX ; Output handle identifier.
         MOV R10,RAX ; Save the (redirected) handle to R10.
         INC RAX     ; Test on INVALID_HANDLE_VALUE (-1).
         STC
         JZ .90: ; Abort with CF when INVALID_HANDLE_VALUE.
         MOV RDI,[%StdOutputString] ; String pointer.
         MOV RCX,[%StdOutputSize] ; String maximal size.
         SUB EAX,EAX
         MOV RDX,RDI  ; Remember start of string in RDX.
         REPNE SCASB ; Find the end of string.
         JNE .10:
         DEC RDI     ; Skip the NUL character.
   .10:  SUB RDI,RDX  ; RDI is now string size in bytes.
         PUSH R9     ; Make room for the written-size DWORD.
          MOV R9,RSP
          WinABI WriteConsoleA,R10,RDX,RDI,R9,0
         POP R9
         CMP R9,RDI  ; Set CF if not all characters were written.
   .90: POP R11,R10,R9,R8,RDX,RCX,RAX
        RET 3*8
      ENDP1 StdOutputAC@RT::
     %ENDIF AC

AF   %IF "%StdOutputRT" === "StdOutputAF@RT"
StdOutputAF@RT:: PROC1 ; ANSI File variant.
        PUSHQ RAX,RCX,RDX,R8,R9,R10,R11
         %StdOutputHandle %SET RSP+80
         %StdOutputSize   %SET RSP+72
         %StdOutputString %SET RSP+64
         MOV RCX,[%StdOutputHandle]
         WinABI GetStdHandle,RCX ; Output handle identifier.
         MOV R10,RAX ; Save the (redirected) handle to R10.
         INC RAX     ; Test on INVALID_HANDLE_VALUE (-1).
         STC
         JZ .90: ; Abort with CF when INVALID_HANDLE_VALUE.
         MOV RDI,[%StdOutputString] ; String pointer.
         MOV RCX,[%StdOutputSize] ; String maximal size.
         SUB EAX,EAX
         MOV RDX,RDI  ; Remember start of string in RDX.
         REPNE SCASB ; Find the end of string.
         JNE .10:
         DEC RDI     ; Skip the NUL character.
   .10:  SUB RDI,RDX ; RDI is now string size in bytes.
         PUSH R9     ; Make room for the written-size DWORD.
          MOV R9,RSP
          WinABI WriteFile,R10,RDX,RDI,R9,0
         POP R9
         CMP R9,RDI  ; Set CF if not all characters were written.
   .90: POP R11,R10,R9,R8,RDX,RCX,RAX
        RET 3*8
      ENDP1 StdOutputAF@RT::
     %ENDIF AF
 %ENDMACRO StdOutput
↑ StdInput Buffer, Size=, Handle=-10

Macro StdInput reads a line terminated with CR from standard input specified by the Handle identifier.

Input
Buffer is offset of memory where the input line will be stored.
Size= is the Buffer size. If omitted (default), macro will use SIZE# attribute of the Buffer.
Handle=-10 is the Windows standard input handle identifier. Possible input values are defined in winscon.htm:
Output
CF=0, RCX=number of bytes read.
Error
CF=1, RCX=0.
StdInput %MACRO Buffer, Size=, Handle=-10
    %IF "%Size"===""
      PUSHQ %Handle, SIZE# %Buffer, %Buffer
    %ELSE
      PUSHQ %Handle, %Size, %Buffer
    %ENDIF
    CALL StdInput@RT
StdInput@RT::PROC1
    PUSH RAX,RDX,R8,R9,R10,R11
     %StdInputHandle %SET RSP+72
     %StdInputSize   %SET RSP+64
     %StdInputBuffer %SET RSP+56
     MOV RAX,[%StdInputHandle]
     WinAPI GetStdHandle,RAX
     SUB ECX,ECX                  ; Clear RCX.
     MOV R10,RAX                  ; Save the handle to R10.
     INC RAX                      ; Test on INVALID_HANDLE_VALUE (-1).
     STC
     JZ .90:   ; Abort with CF when RAX=-1 (INVALID_HANDLE_VALUE).
     MOV R8,[%StdInputBuffer]
     MOV R9,[%StdInputSize]
     PUSH RCX  ; Make room for the read size.
      MOV RCX,RSP
      WinAPI ReadFile,R10,R8,R9,RCX,0
     POP RCX   ; Number of bytes read.
     SUB RAX,1 ; Return CF if ReadFile returned FALSE=0.
.90:POP R11,R10,R9,R8,RDX,RAX
    RET 3*8
   ENDPROC1 StdInput@RT::
  %ENDMACRO StdInput
↑ TerminateProgram Errorlevel=0
This macro provides exit from the running process and the return to the operating system.
It also specifies the Errorlevel (plain number) which can be used to inform the batch script which launched the program whether the program terminated normally or due to some error condition.
Input
Errorlevel= is the return code of the terminating program.
Beside the keyword Errorlevel=, this value may also be specified as an ordinal operand.
When this argument is omitted, it defaults to 0.
Output
is not applicable.
Example
TerminateProgram Errorlevel=[WorstErrLevel] ; Keyword value (from memory). TerminateProgram 8 ; Ordinal value.
TerminateProgram %MACRO Errorlevel=0
     IMPORT ExitProcess
     %IF %#=1 ; If ordinal provided.
       MOV RCX,%1
     %ELSE    ; If keyword provided.
       MOV RCX,%Errorlevel
     %ENDIF
     WinABI ExitProcess,RCX
   %ENDMACRO TerminateProgram
   ENDHEAD winabi

▲Back to the top▲