Using Free Pascal functions and procedures with GNU Cobol.
Pascal, in particular Free Pascal, offers lots of features, that are not available as such in COBOL. Thus, taking the Pascal functionalities, packing them as functions and procedures into a DLL, and calling these routines from a COBOL main program, can be a simple way to extend the possibilities of a COBOL program. Some examples: using the features of the Pascal Crt unit to do console output with cursor positioning and color can be lots simpler and more flexible than using the COBOL screen section. Searching strings for given content using the features of the Free Pascal RegExpr unit is certainly simpler than programming such searches using COBOL. And, concerning the strings themselves: Wouldn't it be cool to be able to use the Pascal Copy, Insert, Delete instructions to manipulate COBOL strings?
If you look at the structure and syntax of Pascal on one hand, and COBOL on the other, you might think that making work together these two programming languages is complicated and tricky. This is not the case! Calling Pascal functions and procedures from a COBOL program works really well, and without that you have to write large wrappers in order to pass the arguments to the subroutines.
This tutorial is about calling Free Pascal functions and procedures from GNU Cobol. No idea, how far it applies to other Pascal or COBOL distributions. The program samples of the tutorial have been developed and tested on Windows 10, using GNU Cobol 3.2 and Lazarus 4.2 (FPC 3.2.2). I suppose that they also work with other versions of Free Pascal and GNU Cobol. The important point is that, because GNU Cobol is a 32-bit application, it's mandatory to use Lazarus 32-bit!
Here are the steps how to build a program, that mixes GNU Cobol and Free Pascal:
- Create the Pascal part in Lazarus. Be sure to declare all functions and procedures, that have arguments, as cdecl. Do not forget to export the routines that will be called by the COBOL program. Finally, build the Pascal part as a library. This will result in the creation of a DLL, that we put together with the COBOL source.
- You can create the COBOL part in OpenCobolIDE, but you should do the build in the console (Command Prompt in Windows). To build the
program:
- Run set_env.bat from the GNU Cobol distribution to set the environment variables needed by the GNU Cobol compiler.
- Build the program as follows:
cobc -x <cobol-source-name>.cbl -L. -l:<pascal-dll-name>.dll
- Before running the executable created, pre-load the DLL:
set COB_PRE_LOAD=<pascal-dll-name>
The following paragraphs list a series of simple program examples, that show how to pass a number or string from COBOL to Pascal, how to return a number from COBOL, how to change the arguments passed by COBOL in the Pascal procedure. At the end of the tutorial, I'll describe two Free Pascal units (that you can include in your Free pascal library code), the first one containing common string routines, the second one containing some console input-output routines. Click the following link to download the source code of all tutorial examples.
Program sample 1: Simple "Hello World" program.
Let's start with something elementary: 2 Free Pascal procedures, displaying a message, called by the GNU Cobol main program.
Here is the code of hello.lpr:
library hello;
{$mode objfpc}{$H+}
procedure SayHello;
begin
Writeln('Hello beautiful world!');
end;
procedure SayBye;
begin
Writeln('Good bye cruel world!');
end;
exports
SayHello,
SayBye;
begin
end.
The screenshot shows the build of the library in Lazarus 32-bit. The result of the build is a DLL named hello.dll.
|
And here is the code of test-hello.cbl:
identification division.
program-id. test-hello.
procedure division.
Main.
call "SayHello".
call "SayBye".
stop run.
end program test-hello.
Note: The Free Pascal procedure and function names are case-sensitive when used as argument in the COBOL call statement!
The screenshot shows the build of the COBOL source file plus the Free Pascal DLL, and the execution of the resulting executable.
|
Program sample 2: Passing integer arguments.
GNU Cobol supports 3 ways to pass arguments to a subroutine: by value, by content, and by reference. Whereas by content may only be used when calling a COBOL subroutine (?), the other two work the same way as the corresponding calls in Pascal. However, it seems that by value only works with numbers (?); passing a character or string always has to be done by reference (?).
Our second program sample consists of a Free Pascal library that determines and prints out if an integer, passed as argument, is a prime number or not, and a main GNU Cobol program, that asks the user for numbers, and passes these to the Pascal procedure.
The question now is: What is the correct data type to use in GNU Cobol, when passing an integer number to a Pascal procedure or function? I'm not sure if these are the only data types that work correctly, but I'm sure that the following do work:
| Free Pascal | GNU Cobol |
|---|---|
| Byte | binary-char unsigned |
| Shortint | binary-char signed |
| Integer (Smallint) | binary-short signed |
| Word | binary-short unsigned |
| Longint | binary-long signed |
| Longword | binary-long unsigned |
Here is the code of primenumbers.lpr:
library primenumbers;
// Algorithm from "Problem Solving and Structured Programming in Pascal", 2nd edition,
// Elliot B. Koffman (Temple University), © ADDISON-WESLEY PUBLISHING COMPANY, INC.
{$mode objfpc}{$H+}
procedure TestPrime(N: Integer); cdecl; forward;
exports
TestPrime;
procedure TestOddNumber(N: Integer; out FirstDiv: Integer; out Prime: Boolean);
begin
Prime := True;
FirstDiv := 3;
while Prime and (FirstDiv <= Sqrt(N)) do begin
if N mod FirstDiv = 0 then
Prime := False
else
FirstDiv += 2;
end;
end;
procedure TestPrimeNumber(N: Integer; out FirstDiv: Integer; out Prime: Boolean);
begin
if N = 2 then
Prime := True
else if not Odd(N) then begin
Prime := False;
FirstDiv := 2
end
else
TestOddNumber(N, FirstDiv, Prime);
end;
procedure TestPrime(N: Integer); cdecl;
var
FirstDiv : Integer;
Prime : Boolean;
begin
TestPrimeNumber(N, FirstDiv, Prime);
if Prime then
Writeln(N, ' is a prime number')
else
Writeln (FirstDiv, ' is the smallest divisor of ', N);
end;
begin
end.
As the Free Pascal procedure awaits data type Integer, we'll have to use data type binary-short signed in our COBOL program. Here is the code of test-primenumbers.cbl:
identification division.
program-id. test-primenumbers.
data division.
working-storage section.
77 NP pic S9(5).
77 NB binary-short signed.
procedure division.
Main.
move 0 to NP.
perform DoTest until NP = -1.
stop run.
DoTest.
display "Enter positive integer greater than 1? "
no advancing.
accept NP.
if (NP > 1) and (NP <= 32767) then
move NP to NB
call "TestPrime" using by value NB
else
move -1 to NP
end-if.
end program test-primenumbers.
The screenshot shows the execution of the program.
|
Program sample 3: Calling functions.
As for an argument being passed by value, the only function return values supported by GNU Cobol seem to be numbers (?). For the rest, function calls are not a big deal; just be sure to use the correct data type!
The program samples consist of a Free Pascal library including a function to calculate the factorial of an integer passed as argument. The GNU Cobol main program asks the user for numbers, passes these to the Pascal function, and displays the function return, i.e. the factorial of the number entered.
Here is the code of factorials.lpr:
library factorials;
{$mode objfpc}{$H+}
function fact(N: Integer): Longint; cdecl; forward;
exports
fact;
function fact(N: Integer): Longint; cdecl;
var
F: Longint;
begin
F := 0;
if N = 1 then
F := 1
else if N > 1 then
F := N * fact(N - 1);
Result := F;
end;
begin
end.
As the function argument is of data type Integer, and the function return of data type Longint (Byte and Longword would have been better choices), the data types in the GNU Cobol program have to be binary-short signed and binary-long signed respectively. Here is the code of test-factorials.cbl:
identification division.
program-id. test-factorials.
data division.
working-storage section.
77 NP pic S99.
77 NB binary-short signed.
77 FB binary-long signed.
77 FP pic S9(9).
procedure division.
Main.
move 0 to NP.
perform DoTest until NP = -1.
stop run.
DoTest.
display "Enter positive integer between 1 and 12? "
no advancing.
accept NP.
if (NP >= 1) and (NP <= 12) then
move NP to NB
call "fact" using by value NB giving FB
move FB to FP
display NP, "! = ", FP
else
move -1 to NP
end-if.
end program test-factorials.
Screenshot of the execution of the program.
|
Program sample 4: Working with decimal numbers.
In COBOL, there are no floating point numbers. All numbers are in fact integers, decimal number variables being declared using a picture clause that includes a virtual decimal separator. It's depending on the position of this virtual decimal separator that the decimal point (or decimal comma) will be placed when displaying a decimal number, or the result of a calculation that includes real numbers. Considering this, it seems obvious that our Pascal functions and procedures have to use variables of type Integer (instead of Real), too.
Here are the steps to make, how I see it to be the best way to proceed, in order to pass a decimal value to a Pascal routine:
- In the COBOL program, multiply the decimal numbers by an appropriate power of ten to get integers. Pass these modified values to the Pascal program
- In the Pascal program, do your calculations, considering the operands and calculation result being integers. If the Pascal routine displays the result, it has to be divided by the appropriate power of 10 before doing so. In the case of a function that returns the result to the COBOL program, return the integer value.
- In the COBOL program, divide the function return by the appropriate power of ten, and assign the obtained value to a variable declared with a picture clause containing a virtual decimal separator.
This seems complicated, but I think that if you've done some examples, you will get used to it. Let's take the example of our next program. The COBOL program asks the user for the adjacent and opposite sides of a triangle, and calls a Pascal function to calculate the hypotenuse. All numbers are considered having 2 decimal digits. To get integers from a number with 2 decimal digits, we have to multiply them by 102 = 100. In the Pascal routine, both sides are 100 times bigger than the effective values. Considering that c = √(a2 + b2), we see that the result will also be 100 times bigger than the effective result. Thus, in the COBOL program, we'll have to use the instruction compute C = CB / 100 to get the correct result into C, declared as something like pic 9(6)V99 (in this instruction, CB is the function result, a Longword in Pascal, declared as binary-long unsigned).
Note: In the case of a multiplication of two numbers with 2 decimal digits, the result would be 100×100 = 10000 times to big. Thus, we would have to divide it by 10000, assigning it to a variable with a picture clause like pic 9(6)V9(4). An alternative would be to divide the result by 100 in the Pascal program and returning this value, rounded to an integer. In the COBOL program, we'll could then divide the function return by 100, and assigning it to a variable declared with a picture clause like pic 9(6)V9(2).
Here is the code of triangle.lpr:
library triangle;
{$mode objfpc}{$H+}
function hypotenuse(A, B: Longword): Longword; cdecl; forward;
exports
hypotenuse;
function hypotenuse(A, B: Longword): Longword; cdecl;
begin
Result := Round(Sqrt(Sqr(A) + Sqr(B)));
end;
begin
end.
And the code of test-triangle.cbl:
identification division.
program-id. test-triangles.
data division.
working-storage section.
01 TriangleSides.
05 A-Input pic ZZ9.99.
05 A pic 9(3)V99.
05 B-Input pic ZZ9.99.
05 B pic 9(3)V99.
05 C pic 9(6)V99.
01 TriangleSides-Bin.
05 AB binary-long unsigned.
05 BB binary-long unsigned.
05 CB binary-long unsigned.
procedure division.
Main.
display "Enter length of side A? "
no advancing.
accept A-Input.
move A-Input to A.
compute AB = 100 * A.
display "Enter length of side B? "
no advancing.
accept B-Input.
move B-Input to B.
compute BB = 100 * B.
call "hypotenuse" using
by value AB,
by value BB,
giving CB.
compute C = CB / 100.
display "Hypotenuse C = ", C.
stop run.
end program test-triangles.
The screenshot shows the execution of the program.
|
Program sample 5: Passing integers by reference.
Passing an argument by reference to a subroutine means not passing the variable's content, but its address in memory. Thus, if we use a such argument within the subroutine, we are actually working with a memory address in the calling program. And that means, that if we modify the variable passed, we actually modify the content of the calling program's variable. In our case: the procedure in the Pascal library will modify the content of some variable declared in the COBOL main program.
The following program sample consists of a Free Pascal procedure that swaps two integers passed as arguments. The GNU Cobol program asks the user for two numbers, and displays them before and after the call to the Free Pascal procedure.
Here is the code of swapintegers.lpr.
library swapintegers;
{$mode objfpc}{$H+}
procedure SwapInt(var N1, N2: Integer); cdecl; forward;
exports
SwapInt;
procedure SwapInt(var N1, N2: Integer); cdecl;
var
N: Integer;
begin
N := N1; N1 := N2; N2 := N;
end;
begin
end.
And the code of test-swapintegers.cbl.
identification division.
program-id. test-swapintegers.
data division.
working-storage section.
77 N1P pic S9(6).
77 N2P pic S9(6).
77 N1B binary-short signed.
77 N2B binary-short signed.
procedure division.
Main.
display "Enter first integer? "
no advancing.
accept N1P.
display "Enter second integer? "
no advancing.
accept N2P.
display "Before calling the Pascal procedure: N1 = ",
N1P, ", N2 = ", N2P.
move N1P to N1B.
move N2P to N2B.
call "SwapInt" using
by reference N1B
by reference N2B.
move N1B to N1P.
move N2B to N2P.
display "After calling the Pascal procedure: N1 = ",
N1P, ", N2 = ", N2P.
end program test-swapintegers.
Note: Be suspicious of COBOL input/output using accept and display. In our example above, the variables used to enter/display the two integer numbers are declared as pic S9(6). This is necessary, even though the largest integer has only 5 digits. In fact, if we use pic S9(5), the last digit of a negative number would not be read in! Entering -22222 would assign -2222 to the variable, and the output would be -02222. Using an edit picture (with "-" and "Z") instead of a number picture would be the better choice. To be absolutely sure that the COBOL program gets the number that you want, use an edit picture (with "-" and "9") and enter the number including all leading zeros.
The screenshot shows the execution of the program.
|
Program sample 6: Using PChar variables for strings.
Besides the original Pascal's array of Char, and the normally used string data types, Free Pascal supports the C-like datatype PChar, i.e. a pointer to a sequence of characters terminated by a null character (ASCII code 00). Using null-terminated strings with COBOL is not the best way to proceed, but it works rather well to pass a COBOL string (to which we'll have to add a null character) to a Pascal PChar variable. Note, that modifying the string within the Pascal procedure is, however, not possible (?).
The following program sample consists of a Free Pascal procedure that concatenates a first and a last name, passed from COBOL to two PChar variables, and displays a personal greeting message. The COBOL program reads the first name and last name from the keyboard, adds a null character and then calls the Pascal procedure with the first name and last name as arguments.
Here is the code of hello2.lpr.
library hello2;
{$mode objfpc}{$H+}
uses
Strings;
procedure HelloUser(FirstName, LastName: PChar); cdecl; forward;
exports
HelloUser;
procedure HelloUser(FirstName, LastName: PChar); cdecl;
var
Message: PChar;
begin
Message := StrAlloc(StrLen(FirstName) + StrLen(LastName) + 8 + 1);
Message := StrMove(Message, 'Hello ', 6 + 1);
StrCat(Message, FirstName);
StrCat(Message, ' ');
StrCat(Message, LastName);
StrCat(Message, '!');
WriteLn(Message);
end;
begin
end.
The length of the message PChar has to equal the length of the two names + the length of the string 'Hello ' + the length of the space between the two names and the length of the exclamation mark at the end of the greeting + 1 for the null-terminator = length of the two names + (6 + 1 + 1) + 1.
Here is the code of test-hello2.cbl.
identification division.
program-id. test-hello2.
data division.
working-storage section.
01 FirstName.
05 FirstName-Str pic x(25).
05 filler pic xx.
01 LastName.
05 LastName-Str pic x(25).
05 filler pic xx.
77 FirstName-PChar pic x(26).
77 LastName-PChar pic x(26).
procedure division.
Main.
move spaces to FirstName, LastName.
display "First name? "
no advancing.
accept FirstName-Str.
display "Last name ? "
no advancing.
accept LastName-Str.
string FirstName delimited by " "
X'00' delimited by size
into FirstName-PChar.
string LastName delimited by " "
X'00' delimited by size
into LastName-PChar.
call "HelloUser" using
by reference FirstName-PChar
by reference LastName-PChar.
stop run.
end program test-hello2.
The maximum length of the names is supposed to be 25. In order to use the COBOL instruction string to add the null-terminator at the end of the names, we must define a delimiter for the strings entered by the user. Declaring them as 25-character variables, followed by two supplementary characters set to spaces, allows us to use a string consisting of two spaces as delimiter. This will correctly work with a 25-character name, as well as with a name that contains one or more single spaces.
The screenshot shows the execution of the program.
|
Program samples 7: Using the routines of the Pascal Crt unit.
The Pascal Crt unit includes a whole bunch of procedures that enhance display in the console, allowing to clear the screen, position the cursor, color output, etc. Creating procedures, calling the Crt routines, in a Pascal library, is a simple way to make these features available to the COBOL main program.
The Free Pascal library used with the following program samples declares procedures to clear the screen, to set the cursor at a given row-column position on the screen, and to print a string using a given text- and background-color. The first COBOL program outputs some text using different colors, the second one displays a yellow "Hello World" within a blue rectangle at the center of the screen.
Here is the code of colordisplay.lpr.
library colordisplay;
{$mode objfpc}{$H+}
uses
Crt;
procedure ClearScreen; forward;
procedure SetCursor(Y, X: Integer); cdecl; forward;
procedure CWrite(FGColor, BGColor: Integer; Str: PChar); cdecl; forward;
procedure CWriteln(FGColor, BGColor: Integer; Str: PChar); cdecl; forward;
exports
ClearScreen,
SetCursor,
CWrite,
CWriteln;
procedure ClearScreen;
begin
ClrScr;
end;
procedure SetCursor(Y, X: Integer); cdecl;
begin
GotoXY(X, Y);
end;
procedure CWrite(FGColor, BGColor: Integer; Str: PChar); cdecl;
begin
TextColor(FGColor);
TextBackground(BGColor);
Write(Str);
end;
procedure CWriteln(FGColor, BGColor: Integer; Str: PChar); cdecl;
begin
CWrite(FGColor, BGColor, Str);
Writeln;
end;
begin
end.
The source code of test-colordisplay.cbl.
identification division.
program-id. test-colordisplay.
data division.
working-storage section.
77 FgColor pic S99.
77 BgColor pic S99.
77 FgColorB binary-short signed.
77 BgColorB binary-short signed.
01 Greeting.
05 filler pic x(23) value "Hello world from COBOL!".
05 filler binary-char value 0.
procedure division.
Main.
display space.
perform DoDisplay
varying FgColor from 0 by 1 until FgColor > 15.
stop run.
DoDisplay.
if FgColor = 0 then
move 7 to BgColor
else
move 0 to BgColor
end-if.
move FgColor to FgColorB.
move BgColor to BgColorB.
call "CWriteln" using
by value FgColorB,
by value BgColorB,
by reference Greeting.
end program test-colordisplay.
The screenshot shows the program output.
|
The source code of test-colordisplay2.cbl.
identification division.
program-id. test-colordisplay2.
data division.
working-storage section.
77 Blue pic S99 value 1.
77 Yellow pic S99 value 14.
77 FgColor binary-short signed.
77 BgColor binary-short signed.
01 Greeting.
05 filler pic x(14) value " Hello world! ".
05 filler binary-char value 0.
01 EmptyLine.
05 filler pic x(14) value spaces.
05 filler binary-char value 0.
procedure division.
Main.
call "ClearScreen".
move Yellow to FgColor.
move Blue to BgColor.
* Centering the message on the screen, the
* screen width supposed to be 100 characters.
call "SetCursor" using
by value 2, by value 43.
call "CWrite" using
by value FgColor, by value BgColor,
by reference EmptyLine.
call "SetCursor" using
by value 3, by value 43.
call "CWrite" using
by value FgColor, by value BgColor,
by reference Greeting.
call "SetCursor" using
by value 4, by value 43.
call "CWrite" using
by value FgColor, by value BgColor,
by reference EmptyLine.
call "SetCursor" using
by value 7, by value 1.
stop run.
end program test-colordisplay2.
The screenshot shows the program output.
|
Note: To display using colors, the output to the screen must be done in the Pascal library. Setting a color in the library code, and displaying the text in the COBOL program does not work. Using the COBOL display instruction will always result in a light-gray text on a black background.
Creating a custom COBOL-Pascal-String data type.
Passing a COBOL string to a Pascal PChar variable works fine, except the transformations that have to be made in the COBOL program (add/remove the null-terminator). The major problem, however, is that it seems not possible to modify the content of the COBOL variable within the Pascal procedure (?). Anyway, there is another possibility: Both COBOL and Pascal support arrays of characters; thus, passing the string as an array of characters seems to be the most obvious way to proceed. However, knowing the string content is not enough for the Pascal procedure. There are two other values, that the procedure has to know: the maximum and actual length of the string. We could pass the three variables as such, but why not use a record? COBOL structures and Pascal records are well compatible, and we may without any problem pass a COBOL structure to a Pascal variable of data type record.
Here is the declaration of our COBOL-Pascal-String data type in Free Pascal.
type
TCobPasString = record
MaxLen, Len: Word;
Str: array[Word] of Char;
end;
The array of characters is declared as a dynamic array, that can contain a maximum of 65536 characters (because we use the data type Word as array index). Obvious that the array maximum and actual lengths have also to be of data type Word in this case.
And here is the declaration of our COBOL-Pascal-String data type in GNU Cobol (as example: a string with a maximum of 255 characters).
01 CobPasString.
05 CPS-MaxLen binary-short unsigned, value 255.
05 CPS-Len binary-short unsigned.
05 CPS-Str.
10 CPS-Str-Char pic x,
occurs 0 to 255 times,
depending on CPS-Len.
The maximum and actual length of the string are contained in variables declared as binary-short unsigned, what corresponds to Word in Pascal. The maximum length of the string (that has to be set in the COBOL program in order to use the structure) is passed to the Pascal procedure as the first item of the record.
Program sample 8: Passing COBOL-Pascal-String arguments.
The following program sample is another simple "Hello User" application. The COBOL program asks the user for their name, puts this name into a COBOL-Pascal-String structure, and passes this structure to a Free Pascal procedure, that uses it to build a personal greeting message.
Here is the code of hello3.lpr.
library hello3;
{$mode objfpc}{$H+}
type
TCobPasString = record
MaxLen, Len: Word;
Str: array[Word] of Char;
end;
procedure SayHello(var CPS: TCobPasString); cdecl; forward;
exports
SayHello;
function CobPasString2String(var CPS: TCobPasString): string;
var
I: Word;
S: string;
begin
S := '';
for I := 0 to CPS.Len - 1 do
S += CPS.Str[I];
Result := S;
end;
procedure SayHello(var CPS: TCobPasString); cdecl;
var
S: string;
begin
S := CobPasString2String(CPS);
Writeln('Hello, ', S, '!');
end;
begin
end.
Notes:
- The COBOL-Pascal-String argument of the procedure "SayHello" has to be declared using var, as the COBOL structure (as all non-number variables) has to be passed by reference.
- The procedure "SayHello" calls the function "CobPasString2String" to convert the COBOL-Pascal-String to a regular Pascal string. This function awaits that the actual string length (second item of the record) is correctly filled in.
- To allow the usage of Free Pascal string variables of any length (as opposed to 255 characters), the build of the library has to be done with the {$H+} option (this option is by default added by Lazarus for any new application/program/library...).
Here is the code of test-hello3.cbl.
identification division.
program-id. test-hello3.
data division.
working-storage section.
77 UserName-Len pic 99.
01 UserName.
05 UserName-Str pic x(25).
05 filler pic xx.
01 CobPasString.
05 CPS-MaxLen binary-short unsigned, value 25.
05 CPS-Len binary-short unsigned.
05 CPS-Str.
10 CPS-Str-Char pic x,
occurs 0 to 25 times,
depending on CPS-Len.
procedure division.
Main.
move spaces to UserName.
display "Your name? "
no advancing.
accept UserName-Str.
inspect UserName tallying UserName-Len
for characters before initial " ".
move UserName-Len to CPS-Len.
move UserName-Str(1:UserName-Len) to CPS-Str.
call "SayHello" using CobPasString.
stop run.
end program test-hello3.
As the Pascal routines await a correct COBOL-Pascal-String value (i.e. with the actual string length filled in), we must determine the length of the user input. This can be done using the inspect instruction. Declaring the user name variable as 25-characters, followed by two supplementary characters set to spaces, ensures that this instruction returns the correct result as well for a name with 25 characters, as for a name containing one or more single spaces (we already saw this way to proceed in program sample 6).
The screenshot shows the program execution.
![GNU Cobol calls Free Pascal: Execution of a program using a custom string data type [1]](./screenshots/gc32_10.jpg "GNU Cobol calls Free Pascal: Execution of a program using a custom string data type [1]")
|
Program sample 9: Modifying COBOL-Pascal-String arguments.
The COBOL-Pascal-String variables are passed to the Free Pascal procedure by reference. This means that what is actually passed is the address of the variables in the COBOL program. Thus, modifying the content of the variables in the Pascal procedure, will modify the content of the COBOL variables.
The following application sample consists of two Free Pascal procedures that transform a COBOL-Pascal-String, passed as argument, to uppercase resp. lowercase. The COBOL program asks the user for some text input, passes this text to the Pascal procedures and displays the text modified by the procedures.
Here is the code of convertcase.lpr.
library convertcase;
{$mode objfpc}{$H+}
uses
SysUtils;
type
TCobPasString = record
MaxLen, Len: Word;
Str: array[Word] of Char;
end;
procedure CobPasUppercase(var CPS: TCobPasString); cdecl; forward;
procedure CobPasLowercase(var CPS: TCobPasString); cdecl; forward;
exports
CobPasUppercase,
CobPasLowercase;
function CobPasString2String(var CPS: TCobPasString): string;
var
I: Word;
S: string;
begin
with CPS do begin
if (MaxLen = 0) or (Len = 0) or (Len > MaxLen) then begin
Writeln('Error when converting Cobol-Pascal-String to string!');
Halt;
end;
S := '';
for I := 0 to Len - 1 do
S += Str[I];
end;
Result := S;
end;
procedure String2CobPasString(S: string; var CPS: TCobPasString);
begin
with CPS do begin
if MaxLen = 0 then begin
Writeln('Error when converting string to Cobol-Pascal-String!');
Halt;
end;
FillChar(Str, MaxLen, ' ');
if Length(S) <= MaxLen then
Len := Length(S)
else
Len := MaxLen;
Move(S[1], Str[0], Len);
end;
end;
procedure CobPasUppercase(var CPS: TCobPasString); cdecl;
var
S: string;
begin
S := UpperCase(CobPasString2String(CPS));
String2CobPasString(S, CPS);
end;
procedure CobPasLowercase(var CPS: TCobPasString); cdecl;
var
S: string;
begin
S := LowerCase(CobPasString2String(CPS));
String2CobPasString(S, CPS);
end;
begin
end.
The uppercase and lowercase procedures call two (internal) helper functions, that convert a COBOL-Pascal-String to a regular Pascal string, resp. convert a regular Pascal string into a COBOL-Pascal-String. The first of these functions will make the program abort if the maximum or actual length of the COBOL-Pascal-String are zero, or if the actual length is set to a value greater than the maximum length. Maybe that you don't agree to abort the program if the actual string length is zero, because this will not allow the usage of empty strings. You can change the procedure code, if you like, however, you should consider that 1. disallowing empty strings makes lots of things lots easier, and 2. there are no empty strings in COBOL (the statement display "", for example, leads to a compilation error, and when using accept, it is not possible to hit ENTER, without entering some data). The second function makes the program abort if the string length exceeds the maximum length of the COBOL-Pascal-String variable. If it exceeds the value set as actual length, the string is truncated. If you prefer that the program should abort in this case, too, feel free to modify the source code accordingly.
Here is the code of test-convertcase.cbl.
identification division.
program-id. test-convertcase.
data division.
working-storage section.
77 Str-Len pic 999.
01 Str.
05 Str-Str pic x(100).
05 filler pic xx.
01 CobPasString.
05 CPS-MaxLen binary-short unsigned, value 100.
05 CPS-Len binary-short unsigned.
05 CPS-Str.
10 CPS-Str-Char pic x,
occurs 0 to 100 times,
depending on CPS-Len.
procedure division.
Main.
move spaces to Str.
display "Enter some text? "
no advancing.
accept Str.
inspect Str tallying Str-Len
for characters before initial " ".
move Str-Len to CPS-Len.
move Str-Str(1:Str-Len) to CPS-Str.
call "CobPasUppercase" using by reference CobPasString.
display CPS-Str(1:Str-Len).
move Str-Str(1:Str-Len) to CPS-Str.
call "CobPasLowercase" using by reference CobPasString.
display CPS-Str(1:Str-Len).
stop run.
end program test-convertcase.
The screenshot shows the program execution.
![GNU Cobol calls Free Pascal: Execution of a program using a custom string data type [2]](./screenshots/gc32_11.jpg "GNU Cobol calls Free Pascal: Execution of a program using a custom string data type [2]")
|
My custom units cps.pas and cpio.pas.
In the rest of the tutorial, I describe two custom units, that you can include into your Free Pascal library, and giving your GNU Cobol program this way access to some useful routines to manipulate strings and console input/output. The unit cps.pas ("cps" for "COBOL-Pascal strings") declares the COBOL-Pascal-String data type TCPS as a record with the 3 items, as seen in the previous examples: MaxLen, Len, Str. The routines of this unit can be used to perform operations on COBOL-Pascal-String variables, such as determining the string length, concatenate two strings, extract a substring, etc. The unit cpio.pas ("cpio" for "COBOL-Pascal input-output"), using itself the cps.pas unit, can be used to perform input-output operations based on the Pascal Crt unit, such as printing in color to a given screen position, checking if a keyboard key has been pressed or waiting until a key is pressed, etc.
Some general notes on using these units:
- In your library code, you have to include the units in the uses statement.
- In your library code, you have to export the routines, that will be used in the COBOL program.
- The routines await valid TCPS variables, i.e. with the maximum and actual string length correctly set.
- The routines only support ASCII (ANSI) strings (no UTF-8).
- Empty strings are not supported.
- The units are entirely free and open source; thus, do not hesitate to add further functionalities, or to adapt the existing routines to your needs.
- The only test of the units' routines, that I actually did, is their usage in the program samples described further down in the tutorial. Thus, the one or other routine may still be buggy. Sorry, if this is the case. And thanks to send me an email in order to let me know.
| The table below shows the functions and procedures available in the cps.pas unit. Please, use the following link to display the source code of the unit in a new browser tab. | ||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||
| And here are the procedures available in the cpio.pas unit. Please, use the following link to display the source code of the unit in a new browser tab. | ||||||||||||||||||||||||||||
| ||||||||||||||||||||||||||||
Program samples 10: Using the units cps.pas and cpio.pas.
The following three program samples show the usage of the some of the functions and procedures of the cps.pas and cpio.pas units. I compiled the programs using a common DLL, build from the Pascal library cobpasstrings.lpr. Note that this library exports all routines of the 2 units, including those that are not actually used by the COBOL programs. Here is the code of cobpasstrings.lpr:
library cobpasstrings;
{$mode objfpc}{$H+}
uses
cps, cpio;
exports
cps_length, cps_trim, cps_fill, cps_concat,
cps_substr, cps_delete, cps_insert, cps_find, cps_replace,
cps_uppercase, cps_lowercase,
cpio_clear_screen, cpio_clear_eol, cpio_clear_lines,
cpio_set_cursor, cpio_write, cpio_writeln, cpio_readln,
cpio_color_write, cpio_color_writeln,
cpio_wait_time, cpio_wait_key, cpio_read_key, cpio_get_key;
begin
end.
The program sample test-cobpasstrings1.cbl shows the usage of the routines cps_length, cps_replace, cps_find, cps_delete, and cps_substr. Here is the code:
identification division.
program-id. test-cobpasstrings1.
data division.
working-storage section.
77 StrLen binary-short signed.
77 StrPos binary-short signed.
77 SLen pic ZZ9.
77 SPos pic ZZ9.
01 Str.
05 filler pic x(21) value "GNU Cobol and Pascal ".
05 filler pic x(24) value "work very well together.".
05 filler pic x(02) value x'0D0A'.
05 filler pic x(31) value "Pascal procedures make it easy ".
05 filler pic x(28) value "to manipulate Cobol strings.".
01 CPS1.
05 CPS-MaxLen1 binary-short unsigned, value 255.
05 CPS-Len1 binary-short unsigned.
05 CPS-Str1.
10 CPS-Str-Chr1 pic x,
occurs 0 to 255 times,
depending on CPS-Len1.
01 CPS2.
05 CPS-MaxLen2 binary-short unsigned, value 255.
05 CPS-Len2 binary-short unsigned.
05 CPS-Str2.
10 CPS-Str-Chr2 pic x,
occurs 0 to 255 times,
depending on CPS-Len2.
01 CPS3.
05 CPS-MaxLen3 binary-short unsigned, value 255.
05 CPS-Len3 binary-short unsigned.
05 CPS-Str3.
10 CPS-Str-Chr3 pic x,
occurs 0 to 255 times,
depending on CPS-Len3.
procedure division.
Main.
display Str.
move CPS-MaxLen1 to CPS-Len1.
move Str to CPS-Str1.
call "cps_length" using
by reference CPS1,
giving strLen.
move strLen to SLen.
display "This string has a length of ", SLen, " characters".
display "> Replacing 'Pascal' by 'Free Pascal':".
move strLen to CPS-Len1.
move 6 to CPS-Len2.
move "Pascal" to CPS-Str2.
move 11 to CPS-Len3.
move "Free Pascal" to CPS-Str3.
call "cps_replace" using
by reference CPS1,
by reference CPS2,
by reference CPS3,
by value 0.
move CPS-Len1 to SLen.
display CPS-Str1(1:SLen).
display "> Replacing all 'Cobol' by 'COBOL':".
move 5 to CPS-Len2.
move "Cobol" to CPS-Str2.
move 5 to CPS-Len3.
move "COBOL" to CPS-Str3.
call "cps_replace" using
by reference CPS1,
by reference CPS2,
by reference CPS3.
move CPS-Len1 to SLen.
display CPS-Str1(1:SLen).
display "> Finding the string 'very'".
move 4 to CPS-Len2.
move "very" to CPS-Str2.
call "cps_find" using
by reference CPS1,
by reference CPS2,
giving StrPos.
move StrPos to SPos.
display "String found at position ", SPos.
display "> Deleting 'very '".
call "cps_delete" using
by reference CPS1,
by value StrPos,
by value 5.
move CPS-Len1 to SLen.
display CPS-Str1(1:SLen).
display "> Extract 11 chars substring at position 15:".
call "cps_substr" using
by reference CPS1,
by value 15,
by value 11.
move CPS-Len1 to SLen.
display CPS-Str1(1:SLen).
stop run.
end program test-cobpasstrings1.
The screenshot shows the program output.
|
The program sample test-cobpasstrings2.cbl shows the usage of the procedures cps_concat, cps_insert, and cps_fill. It also shows how to read a COBOL-Pascal-String value from the keyboard using cpio_readln, and getting the string's "effective value" using cps_trim. Furthermore, it shows how to display strings onto the screen using cpio_clear_screen, cpio_set_cursor, and cpio_write. Here is the code:
identification division.
program-id. test-cobpasstrings2.
data division.
working-storage section.
77 Chr-Space pic x value space.
77 Chr-Star pic x value "*".
01 CPS1.
05 CPS-MaxLen1 binary-short unsigned, value 255.
05 CPS-Len1 binary-short unsigned.
05 CPS-Str1.
10 CPS-Str-Chr1 pic x,
occurs 0 to 255 times,
depending on CPS-Len1.
01 CPS2.
05 CPS-MaxLen2 binary-short unsigned, value 255.
05 CPS-Len2 binary-short unsigned.
05 CPS-Str2.
10 CPS-Str-Chr2 pic x,
occurs 0 to 255 times,
depending on CPS-Len2.
procedure division.
Main.
display "Your first name? "
no advancing.
call "cpio_readln" using
by reference CPS1.
display "Your last name? "
no advancing.
call "cpio_readln" using
by reference CPS2.
call "cps_trim" using
by reference CPS1.
call "cps_trim" using
by reference CPS2.
call "cps_concat" using
by reference CPS1,
by reference CPS2,
by reference Chr-Space.
move 6 to CPS-Len2.
move "Hello " to CPS-Str2.
call "cps_insert" using
by reference CPS1,
by reference CPS2,
by value 1.
move CPS-Len1 to CPS-Len2.
call "cps_fill" using
by reference CPS2,
by reference Chr-Star.
call "cpio_clear_screen".
call "cpio_set_cursor" using
by value 2,
by value 10.
call "cpio_write" using
by reference CPS2.
call "cpio_set_cursor" using
by value 3,
by value 10.
call "cpio_write" using
by reference CPS1.
call "cpio_set_cursor" using
by value 4,
by value 10.
call "cpio_write" using
by reference CPS2.
call "cpio_set_cursor" using
by value 7,
by value 1.
stop run.
end program test-cobpasstrings2.
The screenshot shows the program execution (data input: first name = "Aly", last name = "Baba").
|
And finally, the program sample test-cobpasstrings3.cbl shows how the procedures of the unit cpio.pas can be used to build simple interactive timer based applications. The program displays a "Hello World" message, the color of the text being changed every 2 seconds. This loop continues until the user presses a key (any key in this case) on the keyboard. Here is the code:
identification division.
program-id. test-cobpasstrings3.
data division.
working-storage section.
77 Done pic 9.
77 FgColor binary-char unsigned.
77 BgColor binary-char unsigned.
77 Greeting pic x(25) value " Hello world from COBOL! ".
77 KeyKey binary-char unsigned.
77 KeyNull binary-char unsigned.
01 CobPasString.
05 CPS-MaxLen binary-short unsigned, value 255.
05 CPS-Len binary-short unsigned.
05 CPS-Str.
10 CPS-Str-Char pic x,
occurs 0 to 255 times,
depending on CPS-Len.
procedure division.
Main.
call "cpio_clear_screen".
call "cpio_set_cursor" using
by value 2, by value 41.
move 27 to CPS-Len.
move spaces to CPS-Str.
call "cpio_color_write" using
by reference CobPasString,
by value 1, by value 1,
call "cpio_set_cursor" using
by value 3, by value 41.
call "cpio_color_write" using
by reference CobPasString,
by value 1, by value 1.
call "cpio_set_cursor" using
by value 4, by value 41.
call "cpio_color_write" using
by reference CobPasString,
by value 1, by value 1.
call "cpio_set_cursor" using
by value 7, by value 1.
move 28 to CPS-Len.
move 'Hit any key to terminate... ' to CPS-Str.
call "cpio_write" using
by reference CobPasString.
move 9 to FgColor.
move 0 to BgColor.
move 25 to CPS-Len.
move Greeting to CPS-Str.
move 0 to Done.
perform DoDisplay until Done = 1.
stop run.
DoDisplay.
call "cpio_set_cursor" using
by value 3, by value 42.
call "cpio_color_write" using
by reference CobPasString,
by value FgColor, by value BgColor.
call "cpio_set_cursor" using
by value 7, by value 29.
call "cpio_wait_time" using
by value 2.
Add 1 to FgColor.
if FgColor = 16 then
move 9 to FgColor
end-if.
call "cpio_get_key" using
by reference KeyKey,
by reference KeyNull.
if KeyKey <> 255 then
move 1 to Done
end-if.
end program test-cobpasstrings3.
The screenshot shows the program execution.
|
Note: No idea, where the problem actually lies, but linking a library using the cpio.pas unit into a GNU Cobol program, results in the COBOL accept statement no longer working! Anyway, calling cpio_readln instead is more convenient. And, considering the feature of COBOL to redefine a variable with another data type, this should also work for numeric input (not tested...).
If you find this text helpful, please, support me and this website by signing my guestbook.