Microsoft KB Archive/57741

From BetaArchive Wiki

“-Heap Space Limit Exceeded” When FORTRAN Called from COBOL

PSS ID Number: Q57741 Article last modified on 12-06-1990

3.00 3.00a MS-DOS

Summary: When a Microsoft COBOL version 3.00 or 3.00a program is LINKed with a Microsoft FORTRAN routine, an “out of heap space” error message can occur at run time. This error commonly occurs if screen input or output is performed in the FORTRAN routine. This problem can be worked around by making the FORTRAN routine the main program, which then calls COBOL. The COBOL program can then call the FORTRAN routines that it needs. This information applies to Microsoft COBOL versions 3.00 and 3.00a for MS-DOS.

More Information: For more examples of passing other types of parameters between COBOL and FORTRAN, query on the following word: COB2FOR For a complete discussion about mixed-language programming with COBOL, search in the Software/Data Library for the following word: COBMIXED

Code Example

The following two programs demonstrate the “out of heap space” error. To demonstrate these programs from an .EXE program, compile and link as follows: COBOL COB.CBL; FL /c /FPi /Lr FOR.FOR ; LINK /NOE /NOD COB MINITF FOR,,,LCOBOL LLIBFE ; Please note that the above FORTRAN library LLIBFE.LIB may be called LLIBFER.LIB, depending on how you installed FORTRAN. The following COBOL program is COB.CBL, which calls a FORTRAN procedure and passes an integer by reference: $SET LITLINK IDENTIFICATION DIVISION. DATA DIVISION. WORKING-STORAGE SECTION. 01 FIELD1 PIC 9(4) COMP-5 VALUE 123. PROCEDURE DIVISION. CALL “F_FPROG” USING FIELD1. DISPLAY “Returned PIC 9(4):” FIELD1. STOP RUN. The following program is FOR.FOR, which displays a string literal: SUBROUTINE FPROG(I) INTEGER2 I [FAR] I = 3 WRITE (,*) ‘This is the string’ END COB.EXE produces the following output and then hangs: run-time error F67000) -heap space limit exceeded

Copyright Microsoft Corporation 1990.