From:	ADVAX::"mcnc!WKUVX1.BITNET!MACRO32" 27-JUN-1991 17:36:56.31
To:	MACRO32@WKUVX1.BITNET
CC:	
Subj:	RE: Using optional formal parameters in a FORTRAN subroutine. (repost)

Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Thu, 27 Jun 91 17:32:57 EDT
Received:  from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP
	id AA13953 for ; Thu, 27 Jun 91 16:13:39 -0400
Received: from UKCC.uky.edu by mcnc.mcnc.org (5.59/MCNC/3-21-91)
	id AA03058; Fri, 21 Jun 91 18:08:09 -0400
	for ARISIA.DNET.ge.com!EVERHART
Message-Id: <9106212208.AA03058@mcnc.mcnc.org>
Received: from ukcc.uky.edu by UKCC.uky.edu (IBM VM SMTP V2R1)
   with BSMTP id 9114; Fri, 21 Jun 91 18:07:28 EST
Received: from UKCC by ukcc.uky.edu (Mailer R2.08) with BSMTP id 5158; Fri, 21
 Jun 91 18:07:04 EST
Received: from WKUVX1.BITNET by ukcc.uky.edu (Mailer R2.08) with BSMTP id 5101;
 Fri, 21 Jun 91 18:06:00 EST
Received: from DGOGWDG1.BITNET (MAILER) by WKUVX1 (MX V2.3-1) with BSMTP; Fri,
          21 Jun 1991 16:54:57 CDT
Received: from dnet.gwdg.de by DGOGWDG1.BITNET (Mailer R2.07) with BSMTP id
          6590; Fri, 21 Jun 91 23:49:06 MSZ
Date: Fri, 21 Jun 1991 23:49:03 +0200
From: "GWDGV1::MOELLER" <moeller@gwdgv1.dnet.gwdg.de>
Reply-To: mcnc!WKUVX1.BITNET!MACRO32
To: MACRO32@WKUVX1.BITNET
Subject: RE: Using optional formal parameters in a FORTRAN subroutine. (repost)
 
James Wilkinson <JWILKINSON@HMCVAX.CLAREMONT.EDU> writes:
 
>     I wish to create a fortran subroutine which takes optional arguments.
>[...]
> The compiler lets this go, leaving open the possibility of writing a macro
> routine which one would call before trying to access a, b or c to check the
> argument mask of f.  This will work as long as the parameters which are not
> specified are passed by reference, but if they are passed by descriptor, the
> compiler generates code to interpret the descriptor before control is given
> to the subroutine.
>
>    How could one do this?  Maybe by writing a front-end to any routine
> which optional arguments?  Any suggestions appreciated.
 
You asked for it - here comes the *general* solution.
(I thought that now and then, one might honor the name of the VMS
"assembler" by writing not just machine code, but a real *MACRO*).
 
The MACRO which follows will generate the `frontend' code for
any FORTRAN subprogram, assuming that *all* of its arguments could
be optional. The FORTRAN `backend' routine will always be called
with the proper number of arguments, and it has to test
        %LOC(argument).NE.0
before using a (possibly) optional argument - all is set up such
that this will work even with CHARACTER type arguments.
 
Obviously, in order to generate a `frontend' routine like this,
you'll have to tell the assembler how many arguments the `backend'
routine expects, and which of them will be handled as CHARACTER.
Also, you have to specify (different) names for both `frontend'
and `backend'.
 
So, take the code below, put it into you favorite macro library (say FE.MLB),
and when you have some FORTRAN subprogram with optional arguments, say
        SUBROUTINE SUB_BACKEND(A,C,I)
        REAL A(8)
        CHARACTER C*(*)
        INTEGER I
        IF(%LOC(A).NE.0) ...
        IF(%LOC(C).NE.0) ...
        IF(%LOC(I).NE.0) ...
create its `frontend' (which you might wish to call SUB) by assembling
a short MACRO program (say SUB.MAR) consisting of the 3 lines
 
        .TITLE  SUB frontend
        FRONTEND        SUB,SUB_BACKEND,<0,1,0>
        .END
 
(<0,1,0> is a "prototype" argument list, where 1 indicates CHARACTER,
and 0 any other type of argument) by the command
 
        $MACRO SUB.MAR+FE.MLB/LIBRARY
 
Even better, add /LIST/SHOW=BINARY and enjoy the resulting .LIS file!
 
- cut here --------------------------------------------------------------------
;------------------------------------------------------------------------------
; Macro to generate a `frontend' routine (with all arguments *optional*)
; for a FORTRAN `backend' routine that checks for (%LOC(arg).NE.0)
;
; Invoke as
;       FRONTEND  frontend_name,backend_name,<par1,par2,...>
;
; where par`i' is ...   1  for a character argument
;                       0  for a non-character argument
;
; e.g., to create a `frontend' routine with a name of SUB_FE for
;               SUBROUTINE SUB(I,C,R)
;               CHARACTER C*(*)
; invoke by:
;       FRONTEND        SUB_FE,SUB,<0,1,0>
;------------------------------------------------------------------------------
;
.macro FRONTEND  FRONT,BACK,PARLIST
;
;symbols used:
;
_n      = 0                     ;count entries in `parlist'
_c      = 0                     ;flag: any CHARACTER parameter found
;_i                             ;loop index
;_p<digits>                     ;saved `parlist' entries
;
;local macros:
;
.macro FRONTEND_1  n,par_n     ;process `parlist' entry #n
_p'n'   = par_n                 ;save it in _p'n'
_c      = _c ! par_n            ;note if CHARACTER was found
.endm  FRONTEND_1
;
.macro FRONTEND_2  n           ;generate code for pushing `n'th arg.list entry
.if ne _p'n'                   ;(if CHARACTER argument)
        movl    r1,r0           ; load address of "default" descriptor;
.iff                           ;(else)
        clrl    r0              ; load default address (zero);
.endc
        cmpb    (ap),#'n'               ; called with at least n arguments?;
        blssu   'n'$            ; branch if no - use default;
.if ne _p'n'                   ;(if CHARACTER - not required otherwise)
        tstl    'n'*4(ap)               ; argument #n "void"?;
        beql    'n'$            ; branch if so - use default;
.endc
        movl    'n'*4(ap),r0    ; load argument list entry;
'n'$:   pushl   r0              ; push new argument #n;
.endm  FRONTEND_2
;
;***
;
.irp   __,<PARLIST>            ;iterate over `parlist', saving entries in ...
_n      = _n+1                  ;_p1, _p2 etc. (we'll need them in reverse)
        FRONTEND_1      \_n,__
.endr
;
;                               ;generate entry point
        .entry  FRONT,^m<>
;
.if ne _c                      ;if there are CHARACTER arguments ...
        movq    #0,-(sp)        ; push a "default" descriptor;
        movl    sp,r1           ; and point r1 at it;
.endc
;
_i      = _n                    ;_i: loop_index (counted down)
.repeat _n                     ;loop: process arguments in reverse order
        FRONTEND_2      \_i
_i      = _i - 1
.endr
;
;                               ;generate call to `backend'
.irp   _,\_n                   ;(for pretty /LIST/SHOW=BINARY output, ...
;                               ; convert number in _n to ascii - not required)
        calls   #'_',g^BACK
.endr
        ret                     ; return from 'front';
;
;drop local macros:
.mdelete       FRONTEND_1
.mdelete       FRONTEND_2
;
.endm  FRONTEND
- cut here --------------------------------------------------------------------
 
(If your mailer breaks lines before column 79, the preceding code will be
somewhat screwed up - sorry. Also, if somewhere on the way TABs have been
converted to spaces, the .LIS file won't look quite as pretty. Of course,
I can send this in VMS_SHARE format on demand ...)
 
BTW, since you also asked for a way to find a routine's number of
actual arguments - the following short MACRO program will do:
 
- cut here --------------------------------------------------------------------
        .title  NO_ARGS determine # of arguments passed to caller
;
; INTEGER FUNCTION NO_ARGS() = # of arguments to calling procedure
;
        .entry  NO_ARGS,^m<>
;
        movl    8(fp),r0        ;retrieve caller's AP
        movzbl  (r0),r0         ;get arg count from arg list
        ret
;
        .end
- cut here --------------------------------------------------------------------
 
Wolfgang J. Moeller, GWDG, D-3400 Goettingen, F.R.Germany | Disclaimer ...
Bitnet/Earn: U0012@DGOGWDG5         Phone: +49 551 201516 | No claim intended!
Internet: Moeller@gwdgv1.dnet.gwdg.de   | This space intentionally left blank.
