ABSOFT FORTRAN Glitches and Workarounds

Unexplained compile-time failures and crashes

1. RECORD without STRUCTURE
   Workaround: check for STRUCTURE & RECORD mismatches - especially in INCLUDE files
   
2. GLOBAL DEFINE overflow
   Workaround: move code lines from "global define" into individual routines and functions
   
3. Unmatched "(" and ")" in compiler directives.
   Check that they match - also check INCLUDE files
   

tmod-2612 tmod: INTERNAL
Internal: IR xlate; SOURCE line: 3, file: ..\mrwe\test.f; INTERNAL site: 18401, tag: 23, val: 28tmod-2612 tmod: INTERNAL
Internal: IR xlate; SOURCE line: 3, file: ..\mrwe\test.f; INTERNAL site: 18522, tag: 23, val: 28error on line 99, source file line 3, invalid identifier after handle
Contact technical support
ibe failed.

This occurs with:
CHARACTER*20 X
CALL XX (val(loc(TRIM(X)//char(0))))
END

Workaround:
CHARACTER*20 X
CHARACTER*300 WORKAREA
WORKAREA = TRIM(X)//char(0)
CALL XX (val(loc(WORKAREA)))
END

Unexpected syntax: ")" was expected but found "EOS".

EOS means "end of statement" - make sure "(" and ")" match.

Unrecoverable error encountered while attempting to print buffered messages - hit EOF while trying to issue message 400 at line 5.

EOF means "end of file" - a DOS end-of-file code is at the end of the source code - delete it. It shows as 

Misplaced ^ indicator

CALL XX (val(loc(TRIM(X)))
               ^
cf90-197 f90fe: ERROR $MAIN, File = ..\mrwe\test.f, Line = 3, Column = 35
Unexpected syntax: ")" was expected but found "EOS".

Column = 35 is correct. ^ is incorrectly positioned.

Unable to obtain license: license not found
or I have a license and the software is properly installed! Custom "make" files don't work for me.

Answer: the license must be in the expected folder, e.g., c:\Absoft9.0, and the environment variables must match.
C:\WINDOWS\system32\cmd.exe /K "C:\absoft9.0\BIN\ABSVARS.BAT"
which actions:
set ABSOFT=C:\absoft9.0
set PATH=C:\absoft9.0\BIN;%PATH%
set LIB=C:\absoft9.0\LIB;%LIB%
set INCLUDE=C:\absoft9.0\CINCLUDE;%INCLUDE%

Cray character pointer

        CHARACTER*20 X
        INTEGER*4 ISAVE, Y
        POINTER (PCHAR,X), (PINT,Y)
C DOESN'T WORK
         ISAVE = PCHAR
C  Assignment of a Cray character pointer expression to a INTEGER variable is not allowed.
         PINT = PCHAR
C  Assignment of a Cray character pointer expression to a Cray pointer variable is not allowed.
C DOES WORK
        PINT = ISAVE
        ISAVE = PINT
        PCHAR = PINT
        PCHAR = ISAVE
C SO USE AN INTEGER OR INTEGER POINTER AS A STEP TO ESTABLISHING EVERY CHARACTER POINTER YOU NEED TO MANIPULATE
C       ISAVE = MALLOC(....)
C       PCHAR = ISAVE ! THIS COMPILES
C NOT
C       PCHAR = MALLOC(....)
C       ISAVE = PCHAR ! THIS WON'T COMPILE
        END

Long external names

STDCALL EXTERNAL spssGetNumberofVariables
Identifier length exceeds the maximum of 31 characters.

Cray Character Pointer

Wrong:
character*1 x(*)
pointer (px,x)
Right:
character*1 x(1)
pointer (px,x)

.OR. values

Wrong:
CALL MENUST (val(MF_GRAYED.OR.MF_DISABLED))
Right:
INTEGER*4 V
V = MF_GRAYED.OR.MF_DISABLED
CALL MENUST (val(V))

Unreferenced external names

STDCALL EXTERNAL spssSetVarName
INTEGER*4 spssSetVarName
cf90-1643 f90fe: WARNING mrwe_InitInstance, File = spss.inc, Line = 54, Column = 25
local variable spssSetVarName never referenced.

Workaround: annoying when there are many of these in an INCLUDE file. Remove INCLUDE file, and code only those explicitly used.

# link error: undefined symbol - _GetSystemInfo

Add references to your link alias .als file, and "add" your .als to the linker options
from: to:
_GetSystemMenu _GetSystemMenu@8
unicode.als in the LIB directory tells you what "to:" should be

Changing a library etc. does not force a new link. Make a trivial change to any compiled module, e.g., a blank to the end of a line.

Did you put a char(0) at the end of your Fortran character string?
Also function calls are sometimes buggy - it seems that the internal registers aren't always saved and reset correctly, so place the suspect function call in a separate FORTRAN subroutine by itself. You can check if this is the problem by doing a WRITE (*,*) ... just before the suspect function call. This usually prevents the bug.
It is also advisable to be explicit about the calling convention. For instance
Not: return-value = function (string)
Better: return-value = function (val(loc(trim(string)//char(0))))

In one .f file:
stdcall function mrwe_SpssDlgProc (hDlg, message, wParam, lParam)

In another .f file:
LOGICAL mrwe_SpssDlgProc
EXTERNAL mrwe_SpssDlgProc

So insert in your alias .als file:
_mrwe_SpssDlgProc _mrwe_SpssDlgProc@16

or move the routines into the same .f file

Code to parallel Visual Basic "DoEvents"

call mrwe_yield

To get a two-dimensional numeric array from VB6 to a Fortran dll

This is fortsub.f

        stdcall subroutine fortsub (darray)
        implicit none
        automatic
        integer*4 darray (0:2, 0:3)
        STDCALL EXTERNAL MessageBoxA
        INTEGER*4 MessageBoxA, RETCODE
        RETCODE = MessageBoxA(
     + val(0),
     + val(loc(
     + '+'//CHAR(darray(0,0))//
     + '+'//CHAR(darray(1,2))//
     + '+'//CHAR(darray(2,1))//'+'//CHAR(0))),
     + val(loc("fortsub message box"//CHAR(0))),
     + val(0))
        END

This is f.bat to create fortsub.dll:

f77 -c fortsub.f
echo fortsub > fortsub.xps
echo _fortsub@4 fortsub >fortsub.als
lnk /dll fortsub.obj absRT0.lib user32.lib fmath.lib /exports:fortsub.xps /aliases:fortsub.als

Start VB6, standard Exe, put a Command button on Form1, double-click on the Command button. Paste in this code:

Private Declare Sub fortsub Lib "c:\(your path)\fortsub.dll" (LParam As Any)
Private Sub Command1_Click()
Dim darray(2, 3) As Long
darray(0, 0) = Asc("Z")
darray(1, 2) = Asc("A")
darray(2, 1) = Asc("B")
Call fortsub(darray(0, 0))
End Sub

Then compile and run.  Click on the Command Button. The message box should display:
+Z+A+B+

From Fortran to a Visual Basic dll (useful for calls to Excel etc.)

In VB6.0: project type: ActiveX dll.
Paste into VB6:
---->

   Option Explicit
Public Sub WINVB(A As Long, B As Long, C As Long)
 MsgBox ("Visual Basic (should be 65 66):" +Str$(A)+str$(B))
        A = ASC("X")
        B = ASC("Y")
End Sub

      Public Sub DllRegisterServer()
' nothing here
      End Sub

      Public Sub DllUnregisterServer()
' nothing here
      End Sub

<--- end of paste
Make WINVB.DLL

In Visual C++, new project, static library, winvc; finish.
New source file: add to project, winvc
Paste in the following:
---->
#import "c:\{your path}\WINVB.dll" no_namespace // define import path to VB DLL
long  WINVC(long& A, long& B, long& C) {
try {
  CoInitialize(NULL);
// _Class1Ptr is the Smart pointer wrapper class representing the default interface of the VB object
  _Class1Ptr ptr;
// create instance of VB object. __uuidof(Class1) gets the CLSID of the VB object.
  ptr.CreateInstance(__uuidof(Class1));
  ptr->WINVB(&A, &B, &C);  // send addr of var
 }
catch(_com_error &e) { return (e.Error()) ;}
 CoUninitialize();
 return (0);
}

<--- end of paste

Build winvc.lib.

In Absoft Fortran: fortvb.f:
---->
 PROGRAM FORTVB
 IMPLICIT NONE
 INTEGER*4 A, B
        STDCALL EXTERNAL MessageBoxA
        INTEGER*4 MessageBoxA, RETCODE
 A = 44   ! this is A
 B = 45   ! this is B
 CALL WINVC (A, B, C)
C show the contents in a Message Box to check that we have linked correctly
        RETCODE = MessageBoxA(
     + val(0),
     + val(loc(
     + '+'//CHAR(A)//'+'//CHAR(B)//'+'//CHAR(0))),
     + val(loc("After VB message box: should be +X+Y+"//CHAR(0))),
     + val(0))
C MESSAGE BOX SHOULD BE +X+Y+
        END
<--- end of paste

To compile and run
f77 -c fortvb.f
echo _WINVC ?WINVC@@YAJAAJ00@Z >fortvb.als
lnk -out:fortvb.exe fortvb.obj WINVC.lib fio.lib absRT0.lib user32.lib kernel32.lib fmath.lib libac.lib comdlg32.lib ole32.lib libcpsx.lib msvcrt.lib comsupp.lib oleaut32.lib /aliases:fortvb.als

run: fortvb.exe

ABSOFT FORTRAN skips last line of an ASCII file if it doesn't end LF. So put in an LF

C CHECK THAT LAST MEANINGFUL CODE IS AN "LF" = CHAR(10)

       INTEGER*4 FNUM, IOS, IARRAY(13), FSTAT, FWORK
       CHARACTER*(*) FNAME
       CHARACTER*1 FCHAR

       OPEN (UNIT=FNUM,FILE=FNAME,ACCESS='DIRECT',
     +  RECL=1, IOSTAT=IOS, STATUS='OLD', ACTION='BOTH')

c obtain file statistics
        IOS = FSTAT(FNUM, IARRAY)

C IARRAY(8) IS SIZE OF FILE IN BYTES!
        FWORK = IARRAY(8)

C NOW START READING FILE FROM BACK END UNTIL THERE IS A PROBLEM
50      IF (FWORK.GT.0) THEN
            READ (FNUM,IOSTAT=IOS,REC=FWORK) FCHAR
            IF (IOS.EQ.0) THEN
C IS LAST ACTIVE CODE "LF"? - IF SO, ALL OK
               IF (FCHAR.EQ.CHAR(10)) GOTO 200
               IF (FCHAR.GE.' ') THEN
C LAST ACTIVE CODE IS GREATER OR EQUAL TO BLANK: LF PROBLEM
C SO WRITE LF AT END-OF-FILE
                   WRITE (FNUM,IOSTAT=IOS,REC=IARRAY(8)+1) CHAR(10)
                   GOTO 200
               ENDIF
               FWORK = FWORK - 1
               GOTO 50
              ENDIF
            ENDIF
         ENDIF
200     CLOSE (FNUM, IOSTAT=IOS)

This is useful if the DLL may not exist, or may be a different version to the developer's, or may not have the module, ....

C Do this once to get the entry point
       Subroutine GetDLLEntryPoint (YourEntryPoint)
       stdcall external LoadLibraryA, GetProcAddress
       integer*4 LoadLibraryA, GetProcAddress
       integer*4 pl, pm, plvalue, YourEntryPoint
       character*100 LibraryName, ModuleName
       YourEntryPoint=0
       LibraryName = "KERNEL32.DLL"//char(0)
       ModuleName = "SetFilePointerEx"//char(0)
       pl = loc(YourLibraryName)
       plvalue = LoadLibraryA (val(pl))
       if (plvalue.ne.0) then
         pm = loc(YourModuleName)
         YourEntryPoint = GetProcAddress (val(plvalue), val(pm))
       endif
       end

C Do this each time you need to access the module in the DLL
       if (YourEntryPoint.ne.0) then
         call YourDLLModule (val(YourEntryPoint),val(your parameter 1), val(),...)
       endif

C This does the DLL module access
       SUBROUTINE YourDLLModule (YourEntryPoint, your parameter 1, ...)
       STDCALL EXTERNAL YourEntryPoint
       integer*4 iostat, your parameter 1, ....
       iostat = YourEntryPoint (val(your parameter 1), ....)
       end