Updating FORTRAN code

I’m in the process of porting code written on VAX in FORTRAN77 – and some routines have optional parameters. FORTRAN 77 cannot handle these, but on VAX, it’s easy to retrieve them using a small MACRO module. Not so on Alpha, and Itanium would be even more troublesome – if possible at all due to the architectural differences and processor technology. (See earlier thredas in this catergory).

So I have to choose: re-write the code in another language, or update it to a newer FORTRAN version that allows checking of arguments, as Hoff suggested.

I choose the latter – it proved a far less troublesome task than anticipated.

Consider a routine A, with 4 arguments K, L M and N. K being required and L, M and N optional; however, any of these could be present.

This is the basic FORTRAN 77 code:


SUBROUTINE A (K, L, M, N)

C arguments

INTEGER*4 K
INTEGER*4 L (*)
CHARACTER*(*) M
LOGICAL*4 N

C Local variables

INTEGER*4 S, nmbr, mask

C Routine used to see whether args are present
C Bits in Mask will be set when present

INTEGER*4 GETARGS

C main code

S = GETARGS (Nmbr, Mask)
...
IF (BTEST (Mask,2)) THEN
C
C Parameter L is present
C
ENDIF
....

This routine can be called as:

F = 1
G(1) = 1
G(2) = 1
G(3) = 1
H = "This can be a text of arbitrary length"
I = 0

CALL A (F,G,H,I)
CALL A (F,,H) ! so L and N are missing

Updating the routine to FORTRAN 95 so the optional parameters can be handled, are really minimal: add a line that specifies which arguments are optional, remove the call of the GETARG routine, and use PRESENT (arguments) in stead of BTEST(Mask, bit).
The FORTRAN95 code look like this:

SUBROUTINE A (K, L, M, N)

C arguments

INTEGER*4 K
INTEGER*4 L (*)
CHARACTER*(*) M
LOGICAL*4 N

OPTIONAL :: L, M, N

C Local variables

INTEGER*4 S

C main code

...
IF (PRESENT (L)) THEN
C
C Parameter L is present
C
ENDIF
....

To use this, the routine calling this subroutine must specify the interface. If a routine is heavily used, it’s worthwhile to create an INCLUDE file containing the interface:


INTERFACE
SUBROUTINE A (K, L, M, N)

C arguments

INTEGER*4 K
INTEGER*4 L (*)
CHARACTER*(*) M
LOGICAL*4 N

OPTIONAL :: L, M, N
END SUBROUTINE
END INTERFACE

Add this into calling routines:


INCLUDE 'A_IF.INC'
...
F = 1
G(1) = 1
G(2) = 1
G(3) = 1
H = "This can be a text of arbitrary length"
I = 0

CALL A (F,G,H,I)
CALL A (F,,H) ! so L and N are missing

This is still to be done, but it looks good!

I ran into one problem still to cope with:
CALL B (%VAL (Args))
does not compile: %VAL is out of context here.
The routine in which this code occurs is rather basic – and the mechanism is used heavily in calling routines, where the addresses of allocated memory are passed….
UPDATE
It turned out pretty straight forward. This particular reference turned out to be a parameter to a routine that could easily be bypassed by assigning the right value to a separate variable and use that one instead.

Well, all modules have been built now – except for the ones requiring a missing file but I don’t need that one in due time – and the libraries are created. Next is translating the macro containing the translation vectors into an option file, and vreate the shared image. Afther that, I can start creating the drivers to test it all

Porting VAX macro – 2

The idea doesn’t work either – for the very same reason.
lib$get_curr_invo_context carries one parameter – and that again, overwrites R16 and R17: (In the invo-context structure I defined, IREG is an a1-based array, so the index is one up from the registernumber, so R16 is store in IREG(17). But the principle stayes teh same):

Retstat = lib$get_curr_invo_context (invo_context)

and again, R16 and R17 are gone:

NUMARG\SCS_NUMARG\INVO_CONTEXT.IREG(17): 196736
DBG%gt; exa invo_context.IREG(18)
SCS_NUMARG\NUMARG\INVO_CONTEXT.IREG(18): 196984
DBG%gt; exa @invo_context.IREG(17)
SCS_NUMARG\NUMARG\INVO_CONTEXT.CONTEXT_LENGTH: 544
DBG%gt; exa @invo_context.IREG(18)
SCS_NUMARG\NUMARG\INVO_CONTEXT.IREG(28): 1240184
DBG%gt;

It’s only R18 that holds the value I’m interested in:

DBG%gt; exa @invo_context.IREG(19)
A\A\XXX: 3
DBG%gt;

Examaning the regsiters on routine entry show the right values:

DBG%gt; exa @R16
A\A\X: 1
DBG%gt; exa @R17
A\A\XX: 2
DBG%gt; exa @R18
A\A\XXX: 3
DBG%gt; exa @R19
A\A\XXXX: 4
DBG%gt; exa @R20
%DEBUG-E-NOACCESSR, no read access to address 0000000000000004
DBG%gt;

I think I;ll have to adapt my code….It’s easier that way

Porting VAX macro

To determine the arguments passed to a routine, VAX is easy: the first thing to do is to call a routine that will look back one level, using the frame pointer, to examine the number of arguments, and next traverse the call frame (on stack) to see if any entry is zeroed out (no parameter), or contains a value (parameter present), updating a mask.
Written in VAX MACRO, obviously. And incompilable on Alpha (because the reference of FP).
Nor very useful, either. On Alpha (and Itanium) it’s not that straight forward.
I asked Hoff whether he knows something to solve it – and he gave me some clues, and I went on from there and tried this:


program A
integer*4 x1,x2,x3,4

x1 = 1
x2 = 2
x3 = 3
x4 = 4

Call B (x1,x2,x3,x4) ! ---> R16..r19 (1)

end

Subroutine b (D,E,F,G) ! < --- R16..R19 integer*4 D,E,F,G integer*4 n,m call numarg (n,m) ! ---> R16..R17 (2)

end

subroutine numarg (nmb, msk) ! < ---- r16..R17 integer*4 nmb, msk integer*4 s integer*4 lib$get_curr_inco_context integer*4 lib$get_prev_inco_context external lib$get_curr_inco_context external lib$get_prev_inco_context C invoctxt defined according Calling Standfard manual record /incoctxt/ invo C initilaze invo to be all zeros C get current conetxt (==> numarg itself)

s = lib$get_curr_invo_context (invo) (A)

C get previous context (==> numarg caller)
C (B, in this case)

s = lib$get_prev_invo_conetxt (invo) (B)

after (1), R16..R19 refer to X1, X2, X3 and X4.
After (2), r16..R17 refer to nmb and msk, R18..R19 refer to X3 and X4

At call (A), invo.procedure_descriptor refers numarg, R29 and R30 are the correspionding FP and SP, and R16 and r17 refer to nbr and Msk – quite obvious, because that has been the present call (2)

At call (B), invo.procedure_descriptor refers to B, and R29 and R30 to corresponding FP and SP, which is correct. However, the other registers are unchnaged. Ovious as well, since references to x1 and X2 (in R16 and R17) have been overwitten by call (2) – these have not been saved in memory.

A simple solution: do NOT overwrite the registers, that is: do NOT pass any arguments. It’s not needed since the routine rertrieves data from the sytem without other data than it’s own invokation. It can pass the data in a structure:

Include the following code where numarg is called:

structure /numargdata/
integer*4 nmbr
integer*4 mask
end structure

record /numargdata/ args

record /numargdata/ numarg
external numarg

Change the caller:


args = numarg ()
nmbr = args.nmbr
mask = args.msk

and numrag itself should be changed accordingly. I expect R16..R21 be unchanged.

Or even simpler: just return the mask and forget about the number. Even simpler:


integer*4 numarg
external numarg

msk = numarg ()

Do I need the number ? It is known by design…- and if I really need it, it is at least the highest bit set in the mask – the rest isn’t present anyway and should not be accessed.

Though rework of the code, using OPTIONAL and PRESENT (due to new standards) is preferable, it’s fine for undertanding what goes on in the system.

(To Be Continued)