ASMB,R,L,C
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
*   NAME: PART OF MATH LIBRARY
*   SOURCE:  24998-18XXX  SEE NAM FOR LAST THREE DIGITS 
*   RELOC: PART OF 24998-12001
*   PGMR: BG & JTS
* 
      HED FORTRAN PASS PARAMETER ADDRESSES ROUTINE
      NAM .ENTR,6 24998-1X192 REV.2001 750701 
      ENT .ENTR,.ENTP 
      EXT .ZPRV 
      SPC 2 
* 
*     CALLING SEQUENCES:
*     SUBROUTINE CALL:
*     JSB SUBR
*     DEF *+(N+1) 
*     ARG1
*     ARG2
*      .
*      .
*      .
*     ARGN
* 
*     1) UTILITY ROUTINES : 
*     PARM  BSS M 
*     SUBR  NOP 
*           JSB .ENTR 
*           DEF PARM
*           <RETURN>  SAME AS BELOW 
* 
*     2) PRIVILEGED ROUTINES :
*     PARM  BSS M 
*     SUBR  NOP 
*           JSB $LIBR 
*           NOP 
*           JSB .ENTP 
*           DEF PARM
*           <RETURN> SAME AS BELOW
* 
*     3) RE-ENTRANT ROUTINES :
*     PARM  BSS M 
*     SUBR NOP
*          JSB $LIBR
*           DEF TDB 
*           JSB .ENTP 
*           DEF PARM
*           STA TDB+2 
*           CMB,INB 
*           ADB *-3 
*           STB <NUMBER OF PASSED PARAMETER ADDRESSES)
* 
*     TIME: APPROX 70 + 18/PARAM + 7/INDIRECT + PRIVILEDGE PROC.
*           2100 MACHINE CYCLES.
            SPC 2 
.ENTP NOP 
      JSB .ZPRV 
      DEF LIBX
      LDA .ENTP 
      STA .ENTR 
      LDA =D-2
      JMP INENT 
.ENTR NOP 
      JSB .ZPRV 
      DEF LIBX
      CLA 
INENT STA FAC 
      LDB .ENTR,I   B = SUBR - M
      STB DEST
      CMB           B = M - SUBR - 1
      ADB .ENTR     B = M + 1 
      ADB FAC       B = M -1 FOR RE-ENTRANT OR PRIVL
      STB MPLS1 
      ADB DEST      B = SUBR + 1
      ADB MIN1
      LDA 1,I       A = CALL + 1
      STA SORCE 
      LDA 0,I       GET RETURN ADDRESS
      STA 1,I       SETS INDIRECT BIT IN RETURN ADR.
      STA RTURN     SAVE FOR RE-ENTRANT PROGIES 
      LDA SORCE     A = CALL
      CMA,INA       A = -CALL -1
      ADA SORCE,I   A = N + 1 
      STA 1 
      CMA,INA       A = -N -1 
      ADA MPLS1     A = M - N 
      SSA 
      LDB MPLS1     B = MIN(M,N) + 1
      ISZ .ENTR     BUMP RETURN ADR.
      CMB,INB 
LOOP  INB,SZB,RSS   DONE ?
      JMP EXIT
      ISZ SORCE     ADVANCE POINTER 
      LDA SORCE     GET PARAMETER 
      LDA A,I       GET PARAMETER VALUE 
      RAL,CLE,SLA,ERA  TEST IBIT
      JMP *-2       STILL SET, TRY AGAIN
      STA DEST,I
      ISZ DEST
      JMP LOOP
EXIT  LDA RTURN     A=SAME AS CALLER'S    "NOP" 
      LDB DEST      B=LAST DESTINATION ADDRESS PARAMETER+1
LIBX  JMP .ENTR,I 
      DEF .ENTR 
MIN1  DEC -1
DEST  REP 1 
      NOP 
SORCE REP 1 
      NOP 
MPLS1 REP 1 
      NOP 
FAC   REP 1 
      NOP 
RTURN REP 1 
      NOP 
A     EQU 0 
      END 
* 
                                                                                                                                                        