SPL,L,O, "" ! NAME F2A(7) "92425-16024 REV.1841 780927" ! ! !------------------------------------------------------------- ! ! ! W. FINCH 17MAY76 REV. A ! MODIFIED BY F.WARREN TO BE FORTRAN CALLABLE ! ! "C" COPYRIGHT HEWLETT-PACKARD COMPANY 1976. ! ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM ! MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED ! TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR ! WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. ! !------------------------------------------------------------- ! ! ! ! EXTERNAL PROCEDURES: ! LET %FIX BE FUNCTION,EXTERNAL ! REAL TO INTEGER CONVERSION LET %LOAT BE FUNCTION,EXTERNAL,REAL ! REAL TO INTEGER CONV. LET .IENT BE PSEUDO,REAL ,DIRECT,EXTERNAL ! M.S.DIGIT GET LET PAK BE PSEUDO,INTEGER,DIRECT,EXTERNAL ! CHAR OUTPUTET ! ! EXTERNAL DATA: ! LET BUFP BE INTEGER,EXTERNAL !POINTER FOR PAK ! ! LOCAL PROCEDURES: ! LET PUT BE SUBROUTINE,DIRECT ! CHAR PUT,INCREMENT ! ! LOCAL VARIABLES: ! LET R1 BE REAL ! LOCAL "VALUE" LET W1 BE INTEGER ! PTR TO WD1 OF R1 INITIALIZE W1 TO @R1 LET W2 BE INTEGER ! PTR TO WD2 OF R1 LET EXPNT BE INTEGER ! EXPONENT AFTER NORM LET I1 BE INTEGER ! INTEGER EQUIV. OF R1 LET DIGIT BE INTEGER ! DIGIT (BINARY) LET I BE INTEGER ! LOOP INDEX LET MYBUF BE INTEGER(12) ! FOR FIRST PAK LET RNUMS BE INTEGER(12) ! TERMINATING VALUES INITIALIZE RNUMS TO \ 0.0001, 0.001, 0.01, 0.1, 1.0, 10.0 ! F2A: SUBROUTINE(VALUE,ARRAY)GLOBAL ! LET VALUE BE REAL ! REAL NUM TO BE CONVERTED LET ARRAY BE INTEGER ! OUTPUT BUFFER ! FOR I_1 TO 12 DO \ MYBUF(I)_"0" BUFP_@MYBUF ! SET PAK POINTER W2_W1+1 ! SET WD2 POINTER EXPNT,ARRAY_0 ! INIT EXPONENT,CHAR COUNT_0 IF [R1_VALUE]<0 THEN[ \ IF - R1_ -R1; \ COMPLEMENT IT PUT("-")] ! OUTPUT SIGN IF($W1 OR($W2 AND 177400K))=0 THEN\CHECK FOR 0 MANTISSA GOTO PART2 IF %LOAT([I1_%FIX(R1)])=R1 THEN[ \ IF INTEGER I_ARRAY; \ DVSR_10000; \ WHILE DVSR DO[ \ DIGIT_I1/DVSR; \ I1_.B.; \ IF DIGIT=0 THEN[ \ IF I=ARRAY THEN \ GOTO K1 \ ]; \ PUT(DIGIT); \ K1: DVSR_DVSR/10]; \ GOTO PAK2] IF (($W2 AND 377K)->1) >0 THEN[ \ EXPONENT > 0? UNTIL R1 < 10.0 DO[ \ YES R1_R1/10.0; \ EXPNT_EXPNT+1] \ ], \ ELSE[ \ UNTIL [R1_R1*10.0]>=1.0 DO[ \ EXPONENT =< 0 EXPNT_EXPNT-1]; \ EXPNT_EXPNT-1] PART2: FOR I_0 TO 10 BY 2 DO THRU END2 .IENT()_R1 ! DIGIT_WHOLE PART(R1) DIGIT_"?" !(DIGIT_"?" ON FAIL)SEE ASMB CODE IF DIGIT>9 THEN[ \ CHECK FOR CARRY IF DIGIT#"?" THEN[ \ J_[IF MYBUF(ARRAY)="." THEN ARRAY-1, \ ELSE ARRAY]; \ IF MYBUF(J)="9" THEN[ \ CARRY TO A NINE? MYBUF(J)_"1"; \ YES (FIRST DIGIT ONLY) IF J#ARRAY THEN[ \ OVER A "."? MYBUF(ARRAY)_"0"; \ YES,MOVE THE "." PUT(".")], \ ELSE[ \ PUT("0")] \ NO ], \ ELSE[ \ MYBUF(J)_MYBUF(J)+1];\ CARRY TO 0 THRU 8 PUT(DIGIT-10); \ GOTO K2] \ ] PUT(DIGIT) K2: IF I=0 THEN \ FIRST TIME? PUT(".") R1_(10.0*(R1-%LOAT(DIGIT)))+0.00005 IF R1 < $[REAL](@RNUMS+I) THEN[\ DONE IF NO MORE SIGNIF. GOTO PART3 \ ] END2: PART3: .A._(EXPNT+60)/3 ! COMPUTE EXPONENT MOD 3 XMOD3_.B. IF XMOD3 = 0 THEN \ LEAVE AS IS IF XMOD3=0 GOTO CHOP FOR POINT_1 BY 1 DO[ \ FIND THE "." IF MYBUF(POINT) = "." THEN[ \ GOTO K3] \ ] K3: IF EXPNT= -1 THEN[ \ -1 SPECIAL CASE MYBUF(POINT)_MYBUF(POINT-1); \ MYBUF(POINT-1)_"."; \ EXPNT_0; \ GOTO CHOP] REPEAT XMOD3 TIMES DO[ \ MOVE "." ONCE OR TWICE MYBUF(POINT)_MYBUF(POINT+1); \ MYBUF([POINT_POINT+1])_"."; \ EXPNT_EXPNT-1] CHOP: FOR ARRAY_12 BY -1 DO[ \ TRIM TRAILING "0"'S IF [I_MYBUF(ARRAY)]#"0" THEN[ \ IF I = "." THEN[ \ ARRAY_ARRAY-1]; \ GOTO PAK2] \ ] PAK2: BUFP_@ARRAY+1 ! POINT PAK AT USER BUFFER FOR I_1 TO ARRAY DO \ MOVE AND PACK PAK()_MYBUF(I) IF EXPNT=0 THEN \ RETURN PAK()_"E" ARRAY_ARRAY+2 ! ATLEAST 2 DIGITS IN EXPONENT IF EXPNT<0 THEN[ \ EXPNT_ -EXPNT; \ PAK()_"-"; \ ARRAY_ARRAY+1] IF EXPNT>9 THEN[ \ DIGIT_EXPNT/10; \ EXPNT_.B.; \ PAK()_DIGIT OR "0"; \ ARRAY_ARRAY+1] PAK()_EXPNT OR "0" RETURN END F2A ! PUT: SUBROUTINE(PUTEE)DIRECT ! PAK()_0 ! ZERO FILL LEFT PART PAK()_[IF PUTEE<10 THEN PUTEE OR "0", \ ELSE PUTEE] ARRAY_ARRAY+1 RETURN END PUT ! END S1685 ! END$