Calling Assembly Language Routines from LF95 Code Kenneth G. Hamilton, 12-Oct-1998 1. LF95 Conventions This section is intended to assist the experienced assembly language programmer in writing subprograms that can be called by LF95-compiled Fortran code. The examples that follow were processed by Microsoft MASM v6.11a, although any recent assembler will likely suffice. In addition to this information, you should also have on hand appropriate documentation for your assembler. The examples in this writeup can be found in subdirectories EXAMPLES\MIX_LANG\ASSEMBLY\EX1, EX2, EX3, etc. Each sample program can be compiled and linked by using the GEN.BAT file that accompanies it. 2. Example 1: Simple Addition. PROGRAM ADDMAIN integer :: i,j,k,l i = 17 j = 24 call foradd(i,j,k) print *, 'i,j,k=',i,j,k i = 52 j = 16 call asmadd(i,j,l) print *, 'i,j,l=',i,j,l stop end SUBROUTINE FORADD(II,JJ,KK) kk = ii+jj return end You should note that ADDMAIN also calls a second subroutine, ASMADD. Here it is: TITLE ASMADD .386 .MODEL FLAT ; _ACODE SEGMENT PARA USE32 PUBLIC 'CODE' ASSUME CS:_ACODE PUBLIC _asmadd_ ; Entry point name _asmadd_ PROC NEAR ; Start of procedure push ebp ; Save EBP mov ebp,esp ; Will use EBP for args push ebx ; Must save EBX mov eax,[ebp+8] ; 1st arg addr mov ecx,[ebp+12] ; 2nd arg addr mov edx,[ebp+16] ; 3rd arg addr mov ebx,[eax] ; 1st arg value mov eax,[ecx] ; 2nd arg value add eax,ebx ; Form I+J mov [edx],eax ; Store into K pop ebx ; Restore saved EBX mov esp,ebp ; Restore stack pointer pop ebp ; Restore base pointer ret ; Return to caller _asmadd_ ENDP ; End of procedure _ACODE ENDS ; End of segment END ASMADD is the assembly-language translation of FORADD: it also takes three variables, adds the first two, and returns the result in the third one. Examining ASMADD, we can see that once the preamble is completed, the addresses of the arguments are accessible to the assembly-language routine in EBP+8, EBP+12, and EBP+16. Since the EBX register is used in the processing, its contents must be preserved by being pushed onto the stack before it is clobbered, and popped off later. LF95 assumes that the caller will fix the stack, i.e., remove the argument address pointers. As a result, the return to the calling routine is accomplished by means of a simple RET instruction. 3. Example 2: Using local data. Now, let us examine a case in which a subroutine contains some local data. The main program MULMAIN calls two subroutines, FORMUL (written in Fortran), and ASMMUL written in assembly language. Both FORMUL and ASMMUL do the same thing: multiply the first argument by 7, add 3, and then return the result as the second argument. This is the Fortran part: PROGRAM MULMAIN integer :: i,j,k,l i = 5 call formul(i,j) print *, 'i,j=',i,j k = 3 call asmmul(k,l) print *, 'k,l=',k,l stop end SUBROUTINE FORMUL(II,JJ) jj = 7*ii + 3 return end Here is the assembly-language subroutine ASMMUL, with two constants m1 and m2 stored in a local data area. TITLE ASMMUL .386 .MODEL FLAT ; _ACODE SEGMENT PARA USE32 PUBLIC 'CODE' ASSUME CS:_ACODE, DS:_ADATA PUBLIC _asmmul_ ; Entry point name _asmmul_ PROC NEAR ; Start of procedure push ebp ; Save base pointer mov ebp,esp ; Save stack pointer mov eax,[ebp+8] ; 1st arg addr mov eax,[eax] ; 1st arg EAX=I mov ecx, m1 ; 7 into ECX mul ecx ; 7*I is in EAX add eax, m2 ; 7*I+3 is in EAX mov edx,[ebp+12] ; 2nd arg addr mov [edx],eax ; Store in 2nd arg (J) mov esp,ebp ; Restore stack pointer pop ebp ; Restore base pointer ret _asmmul_ ENDP _ACODE ENDS ; _ADATA SEGMENT PARA USE32 PUBLIC 'DATA' m1 dd 7 m2 dd 3 _ADATA ENDS ; END The two variables are initialized to values of 7 and 3, and are not altered. Quantities stored in this manner could be changed during the course of computation, if required. Alternatively, this routine could have been written with the constants 7 and 3 being coded as immediate data in the MOV and ADD instructions that use them. 4. Example 3: Using floating-point arithmetic. Floating point arithmetic is also possible in an assembly language routine that is called from an LF95 program. Here is an example of a main program (FLTMAIN) that calls two functionally-identical subroutines, FORFLT and ASMFLT, which are written in Fortran and assembly lanaguage, respectively. PROGRAM FLTMAIN real :: x, y, z x = 3.0 y = 8.5 call forflt(x,y,z) print 20, x,y,z 20 format (' x,y,z=',3F10.4) x = 4.5 y = 7.1 call asmflt(x,y,z) print 20, x,y,z stop end SUBROUTINE FORFLT(XX,YY,ZZ) zz = 3.1*xx + yy + 7.6 return end This is the assembly language routine, and we can see that REAL variables are also passed as addresses, located in EBP+8, EBP+12, EBP+16, etc. TITLE ASMFLT .386 .MODEL FLAT ; _ACODE SEGMENT PARA USE32 PUBLIC 'CODE' ASSUME CS:_ACODE, DS:_ADATA PUBLIC _asmflt_ ; Entry point name _asmflt_ PROC NEAR ; Start of procedure push ebp ; Save base pointer mov ebp,esp ; Save stack pointer mov eax,[ebp+8] ; Addr X mov ecx,[ebp+12] ; Addr Y mov edx,[ebp+16] ; Addr Z fld dword ptr d1 ; Load 3.1 fmul dword ptr [eax] ; 3.1*X fadd dword ptr [ecx] ; 3.1*X+Y fadd dword ptr d2 ; 3.1*X+Y+7.6 fstp dword ptr [edx] ; Store into Z mov esp,ebp ; Restore stack pointer pop ebp ; Restore base pointer ret _asmflt_ ENDP _ACODE ENDS ; _ADATA SEGMENT PARA USE32 PUBLIC 'DATA' d1 dd 3.1 d2 dd 7.6 _ADATA ENDS ; END In assembly language, it is necessary to access the values of the variables using the keywords DWORD PTR for REAL(KIND=4) and QWORD PTR for REAL(KIND=8) variables. 5. Example 4: Using COMMON blocks. If it is necessary for an assembly language subroutine to access the contents of a COMMON block, then we must find the starting address of that block. The starting address of a named COMMON is put in a global variable; the name of that variable is composed by converting the COMMON block's name to lower case letters, and then attaching an underscore before and after the name. Thus, the starting address of a COMMON block that is named ZOOM can be found in the global variable _zoom_ . The starting address of blank COMMON is placed in the global variable __BLNK__. (Note that there are two underscore symbols both before and after the word ``BLNK.'') In the following example, both blank COMMON and COMMON/RRR/ are passed to a Fortran subroutine (FORCOM) and its assembly language equivalent (ASMCOM), where some minor calculations are performed. PROGRAM CMNMAIN common i,j,k common /rrr/ x,y,z i = 4; j = 17; k = 0 x = 1.6; y = 3.7; z = 0.0 call forcom print 10, i,j,k 10 format (' i,j,k=',3I6) print 20, x,y,z 20 format (' x,y,z=',3F10.4) i = 4; j = 17; k = 0 x = 1.6; y = 3.7; z = 0.0 call asmcom print 10, i,j,k print 20, x,y,z stop end SUBROUTINE FORCOM common i,j,k common /rrr/ x,y,z k = 5*i + j z = x*y return end This is ASMCOM, the assembly language subroutine that manipulates variables in the two COMMON blocks. TITLE ASMCOM .386 .MODEL FLAT ; BLNKCOM STRUCT i dword ? j dword ? k dword ? BLNKCOM ENDS ; EXTERN __BLNK__:BLNKCOM ; RRRCOM STRUCT x real4 ? y real4 ? z real4 ? RRRCOM ENDS ; EXTRN _rrr_:RRRCOM ; _ACODE SEGMENT PARA USE32 PUBLIC 'CODE' ASSUME CS:_ACODE, DS:_ADATA PUBLIC _asmcom_ ; Entry point name _asmcom_ PROC NEAR ; Start of procedure push ebp ; Save EBP mov ebp,esp ; Will use EBP for args mov eax, dword ptr __BLNK__.i; Get I mov ecx, m1 ; Load 5 mul ecx ; Form 5*I add eax, dword ptr __BLNK__.j; 5*I+J mov dword ptr __BLNK__.k,eax ; Store into K fld dword ptr _rrr_.x ; Load X fmul dword ptr _rrr_.y ; Form X*Y fstp dword ptr _rrr_.z ; Z=X*Y mov esp,ebp ; Restore stack pointer pop ebp ; Restore base pointer ret ; Return to caller _asmcom_ ENDP ; End of procedure _ACODE ENDS ; End of segment ; _ADATA SEGMENT PARA USE32 PUBLIC 'DATA' m1 dd 5 _ADATA ENDS ; END The starting addresses of the COMMON blocks are obtained by using EXTERN directives to connect to the global values. The individual variables within a COMMON block can then be accessed as STRUCTs that are written so as to match the layout of the Fortran code's COMMON declarations. Each COMMON block must consist of a STRUCT definition, plus an EXTERN declaration to connect it to the global data object. 6. Example 5: CHARACTER arguments. Type CHARACTER variables are passed to subroutines as two arguments: the starting address of the string, and the string's length. The two arguments are not, however, pushed consecutively onto the stack. Rather, the address pointer is pushed in the usual order, and then after all arguments have been passed, the lengths of any CHARACTER arguments are passed by value. Here is an example of a main program (CHRMAIN), that calls a Fortran subroutine (FORCAPS), and its assembly language equivalent (ASMCAPS). Both FORCAPS and ASMCAPS take two CHARACTER arguments; the first argument is converted into all upper case letters, and then returned in the second argument. PROGRAM CHRMAIN character (len=20) :: line1, line2, line3 line1 = 'This is a message' line2 = 'zzzzzzzzzzzzzzzzzzzz' line3 = 'aaaaaaaaaaaaaaaaaaaa' call forcaps(line1,line2) print 20, line1 print 20, line2 20 format (1X,A) call asmcaps(line1,line3) print 20, line1 print 20, line3 stop end SUBROUTINE FORCAPS(L1,L2) character*(*) :: l1, l2 n = len(l1) ! Converts all do i=1,n ! chars to caps ic = ichar(l1(i:i)) if (ic.ge.97 .and. ic.le.122) ic = ic-32 l2(i:i) = char(ic) enddo return end This is the assembly language string capitalization routine. TITLE ASMCAPS .386 .MODEL FLAT ; _ACODE SEGMENT PARA USE32 PUBLIC 'CODE' ASSUME CS:_ACODE PUBLIC _asmcaps_ ; Entry point name _asmcaps_ PROC NEAR ; Start of procedure push ebp ; Save EBP mov ebp,esp ; Will use EBP for args push esi ; Must preserve ESI push edi ; Must preserve EDI ; mov esi,[ebp+8] ; 1st string addr (L1) mov edi,[ebp+12] ; 2nd string addr (L2) mov ecx,[ebp+16] ; 1st string length cmp ecx, 0 ; Length nonpositive? jle Exit ; Yes, so return ; Looper: mov al, [esi] ; Get char from L1 cmp al, 97 ; Below "a"? jl PutIt ; Yes, so no conversion cmp al, 122 ; Above "z"? jg PutIt ; Yes, so no conversion sub al, 32 ; Change LC to UC PutIt: mov [edi], al ; Store inc esi ; Point to next char inc edi ; Point to next target loop Looper ; Loop until done ; Exit: pop edi ; Restore saved EDI pop esi ; Restore saved ESI mov esp,ebp ; Restore stack pointer pop ebp ; Restore base pointer ret ; Return to caller _asmcaps_ ENDP ; End of procedure _ACODE ENDS ; End of segment END Note that the starting addresses of the arguments are stored in EBP+8 and EBP+12, while the lengths of the two CHARACTER variables are in EBP+16 and EBP+20. In this code, we do not make use of the length of the second string, assuming it to be equal to that of the first one. Since we use the ESI and EDI registers in this subroutine, we save their previous values on the stack and restore them before returning. 7. Example 6: A COMPLEX Function When an LF95 program calls a COMPLEX-valued function, it first pushes the argument addresses onto the stack, and then also pushes the address of a place where the function should store its return value. Thus, after the function preamble (where the contents of ESP are stored into EBP), EBP+8 will contain the address of the return buffer, and the normal argument pointers will start at EBP+12. Here is an example of a program that passes a COMPLEX variable to a COMPLEX-valued Fortran function CXFFUN that returns two times its argument. PROGRAM CXMAIN complex :: a, b, c, cxffun, cxafun a = (1.0,2.0) b = cxffun(a) c = cxafun(a) print *, 'a=',a print *, 'b=',b print *, 'c=',c stop end FUNCTION CXFFUN(A) complex :: a, cxffun cxffun = a+a return end The above program also calls a COMPLEX-valued assembly language function CXAFUN, that performs exactly the same operation as CXFFUN, i.e., it returns double the argument. TITLE CXAFUN .386 .MODEL FLAT ; _ACODE SEGMENT PARA USE32 PUBLIC 'CODE' ASSUME CS:_ACODE PUBLIC _cxafun_ ; Entry point name _cxafun_ PROC NEAR ; Start of procedure push ebp ; Save EBP mov ebp,esp ; Will use EBP for args ; mov eax, [ebp+12] ; Argument address fld dword ptr [eax] ; Get real part fadd dword ptr [eax] ; Double it fld dword ptr [eax+4] ; Get imag part fadd dword ptr [eax+4] ; Double it ; mov eax, [ebp+8] ; Return buffer address fstp dword ptr [eax+4] ; Store imag part fstp dword ptr [eax] ; Store real part ; mov esp,ebp ; Restore stack pointer pop ebp ; Restore base pointer ret ; Return to caller _cxafun_ ENDP ; End of procedure _ACODE ENDS ; End of segment END Looking at this function, we can see that the single argument's address is stored in EBP+12. That is the address of the real part of the argument, with the imaginary part being stored four bytes higher in memory. Both parts of the argument are copied into the FPU and doubled. The results are then stored into the return buffer, whose address is found at EBP+8. That is, of course, the address of the real part and the imaginary component is stored four bytes higher. 8. Example 7: A CHARACTER Function A somewhat more complicated mechanism is used for CHARACTER-valued functions. After the argument information has been pushed on the stack, they are followed by the length and starting address of the memory buffer that will accept the result. As a consequence, the return buffer's address can be found in EBP+8, and its length in EBP+12. The address of the first argument is then moved up to EBP+16, and any other arguments follow in the usual manner. Here is a Fortran main program that sets a CHARACTER variable equal to the string ``Hello,'' and then calls a Fortran function (FFUN) that returns a capitalized form of the string. The program then calls an assembly language function (AFUN) that returns a decapitalized version. PROGRAM CHMAIN character*20 a, b, c, ffun, afun a = 'Hello' b = ffun(a) c = afun(b) print 20, a, b, c 20 format (' a = ',A/' b = ',A/' c = ',A) stop end CHARACTER*20 FUNCTION FFUN(A) character*(*) a n = len(a) do i=1,n ic = ichar(a(i:i)) if (ic.ge.97 .and. ic.le.122) ic = ic-32 ffun(i:i) = char(ic) enddo return end This is the CHARACTER-valued assembly language function that is used by the program above: TITLE AFUN .386 .MODEL FLAT ; _ACODE SEGMENT PARA USE32 PUBLIC 'CODE' ASSUME CS:_ACODE PUBLIC _afun_ ; Entry point name _afun_ PROC NEAR ; Start of procedure push ebp ; Save EBP mov ebp,esp ; Will use EBP for args push esi push edi ; mov edx, [ebp+12] ; Length of return buffer mov eax, [ebp+20] ; Length of argument cmp edx, eax ; Which is smaller? jg L10 ; Return buffer mov ecx, edx ; Get arg length jmp L20 L10: mov ecx, eax ; Get ret buf length L20: cmp ecx, 0 ; Length nonpositive? jle L90 ; Yes, so return ; mov esi, [ebp+16] ; Addr of argument mov edi, [ebp+8] ; Addr of ret buf L30: mov al, [esi] ; Get char from L1 cmp al, 65 ; Below "A"? jl L40 ; Yes, so no conversion cmp al, 90 ; Above "Z"? jg L40 ; Yes, so no conversion add al, 32 ; Change UC to LC L40: mov [edi], al ; Store inc esi ; Point to next char inc edi ; Point to next target loop L30 ; Loop until done ; L90: pop edi ; Restore saved EDI pop esi mov esp,ebp ; Restore stack pointer pop ebp ; Restore base pointer ret ; Return to caller _afun_ ENDP ; End of procedure _ACODE ENDS ; End of segment END The sole argument is passed with its starting address in EBP+16, and its length in EBP+20 --- remember that if there are several arguments, then the CHARACTER lengths follow the entire list of addresses. The return buffer, the place where the function should store its return value is communicated by its starting address (in EBP+8) and length (in EBP+12).