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 * * * *********************************************************************** * 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