ASMB,R,L,C
      NAM CABS,6 24998-1X164 REV.2013 791016
      ENT CABS
      EXT .ZRNT,.ENTP,SQRT,..FCM
*********************************************************************** 
*                                                                     * 
*     NAME: CABS                                                      * 
*   SOURCE: 24998-18164                                               * 
*    RELOC: PART OF 24998-12002                                       * 
*     PGMR: CRG                                                       * 
*                                                                     * 
*********************************************************************** 
*                                                                     * 
*     (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.           * 
*                                                                     * 
*********************************************************************** 
* 
* 
*     COMPLEX ABSOLUTE VALUE
* 
*     CALLING SEQUENCE:   Y=CABS(X) 
* 
*                         JSB CABS
*                         DEF *+2 
*                         DEF X 
*                         <RESULT IN (A B)> 
* 
* 
*********************************************************************** 
* 
TDB   NOP 
      ABS CABS-TDB
TDBP2 NOP 
L     BSS 2 
S     BSS 2 
X     BSS 1 
* 
CABS  NOP           ENTRY POINT 
      JSB .ZRNT 
      DEF LIBX
      JSB .ENTP     GET ADDRESSES 
      DEF X 
      STA TDBP2     SAVE RTN ADDR 
* 
*********************************************************************** 
      SKP 
*********************************************************************** 
* 
*     CALCULATE S = ABS(REAL(X))
* 
      DLD X,I       GET REAL(X) 
      SSA           SKIP IF POISITIVE 
      JSB ..FCM     ABS(REAL(X))
      DST S 
* 
*********************************************************************** 
* 
*     CALCULATE L = ABS(IMAG(X))
* 
      ISZ X         BUMP ADDR(X)
      ISZ X 
      DLD X,I       GET IMAG(X) 
      SSA           SKIP IF POSITIVE
      JSB ..FCM     ABS(IMAG(X))
      DST L 
* 
*********************************************************************** 
* 
*     COMPARE S TO L AND SWAP IF LARGER 
* 
      FSB S         L - S 
      SSA,RSS       SKIP IF NEGATIVE
      JMP OK        JUMP IF L > S 
* 
      LDA L         SWAP L AND S
      LDB S 
      STA S 
      STB L 
      LDA L+1 
      LDB S+1 
      STA S+1 
      STB L+1 
* 
*********************************************************************** 
* 
*     TEST FOR X = 0
* 
OK    LDA L         GET LARGER VALUE
      SZA,RSS       SKIP IF NOT ZERO
      JMP LIBX      X = 0, RETURN ZERO
* 
*********************************************************************** 
      SKP 
*********************************************************************** 
* 
*     FINISH CALCULATION
* 
      DLD S 
      FDV L         S / L 
      FMP A         (S / L)**2
      FAD F1.0      1.0 + (S / L)**2
      JSB SQRT      SQRT(1.0 + (S / L)**2)) 
      HLT 33B       NEVER ERROR RETURN
* 
      FMP L         L * SQRT(1.0 + (S / L)**2)) 
* 
*********************************************************************** 
* 
*     EXIT
* 
LIBX  JMP TDBP2,I   RETURN
      DEF TDB 
      DEC 0 
* 
*********************************************************************** 
* 
A     EQU 0 
F1.0  DEC 1.0 
* 
*********************************************************************** 
      END 
                                  