Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap1_198111 - decus/20-0001/muladd.for
There is 1 other file named muladd.for in the archive. Click here to see a list.
C
C
C
C            COPYRIGHT (c) 1977 BY
C    DIGITAL EQUIPMENT CORPORTATION, MAYNARD, MASS.
C   
C  THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND  COPIED
C  ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH  LICENSE AND WITH THE
C  INCLUSION OF THE  ABOVE COPYRIGHT NOTICE.  THIS  SOFTWARE OR ANY OTHER
C  COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE  MADE AVAILABLE TO ANY
C  OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF  THE  SOFTWARE  IS  HEREBY
C  TRANSFERRED.
C 
C  THE INFORMATION IN THIS  SOFTWARE IS SUBJECT TO CHANGE  WITHOUT NOTICE
C  AND  SHOULD  NOT  BE  CONSTRUED AS A COMMITMENT BY  DIGITAL  EQUIPMENT
C  CORPORATION.
C 
C  DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
C  SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
C 
C 
C 
C
C
C
C
C
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C   +                                                +
C   +            CALC    VERSION  X01-01             +
C   +                                                +
C   +  PETER BAUM  1-SEP-77                          +
C   +  DIGITAL EQUIPMENT CORPORATION                 +
C   +  146 MAIN STREET                               +
C   +  MAYNARD, MASSACHUSETTS  01754                 +
C   +                                                +
C   ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C
C
C **************************************************
C *                                                *
C *     SUBROUTINE MULADD (PT1,PT2,RETCD,ENTRY)    *
C *                                                *
C **************************************************
C
C
C MULTIPLE PRECISION ADDITION AND SUBTRACTION ROUTINE.
C
C
C
C   ENTRY #  ACTION
C     1       M10ADD	ARGUMENT LIST IS (PT1,PT2,RETCD,ENTRY)
C     2       M8ADD	WHERE THE OPERATION OPR IS PERFORMED
C     3       M16ADD	AS FOLLOWS:
C     4       M10SUB
C     5       M8SUB	STACK1( ,PT1) GETS VALUE
C     6       M16SUB	STACK1( ,PT1) OPR STACK2 ( ,PT2)
C
C  NOTE:  STACK2 IS NOT CLEANED UP BY THE OPERATION
C
C  RETCD = 1	NORMAL
C	   2	ERROR
C
C
C
C  MODIFICATION CLASSES: M3, M10
C
C
C
C
C
C
C MULADD CALLS ERRMSG TO PRINT ERROR MESSAGES.
C
C
C
C MULADD IS CALLED BY CALBIN
C
C
C
C
C     VARIABLE     USE
C
C    BASE      BASE OF NUMBERS BEING ADDED.
C    CARRY     HOLDS CARRY AS OPERATION IS PERFORMED.
C    ENTRY     CODED SPECIFICATION OF BASE AND OPERATION (ADD OR SUBTRACT)
C    I,K       TEMPORARY VALUES.
C    PT1       POINTER TO OPERAND 1 (IN STACK 1)
C    PT2       POINTER TO OPERAND 2 (IN STACK 2)
C    RETCD     RETURN CODE: 1=O.K., 2=ERROR
C    SW        SWITCH: 1=NEGATIVE, 0=POSITIVE.
C    TEMP      HOLDS TEMPORARY VALUES.
C
C
C
C
C
	SUBROUTINE MULADD (PT1,PT2,RETCD,ENTRY)
C
C
	INTEGER*2 ST1TYP(40),ST2TYP(40)
	INTEGER*2 RETCD,ENTRY
	INTEGER*2 PT1,PT2
	INTEGER*2 ST1PT,ST2PT,ST1LIM,ST2LIM
	INTEGER*2 BASE,CARRY,TEMP,SW
	INTEGER*2 I,K
C
	LOGICAL*1 STACK1(100,40),STACK2(100,40)
C
	COMMON /STACK/STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
     ;         ST1LIM,ST2LIM
C
C
	GO TO (10,20,30,40,60,70),ENTRY
	STOP 10
C
C ADD BASE 10
10	BASE=10
	GOTO 100
C
C ADD BASE 8
20	BASE=8
	GOTO 100
C
C ADD BASE 16
30	BASE=16
	GOTO 100
C
C SUBTRACT BASE 10
40	BASE=10
C
C CONVERT A - B TO A + (-B)
50	STACK2(100,PT2)=1-STACK2(100,PT2)
	GOTO 100
C
C SUBTRACT BASE 8
60	BASE=8
	GOTO 50
C
C SUBTRACT BASE 16
70	BASE=16
	GOTO 50
C
C
C  SET UP RETURN CODE DEFAULT VALUE
100	RETCD=1
C
C
C  GO ELSEWHERE IF SIGNS ARE NOT THE SAME
	IF (STACK1(100,PT1).NE.STACK2(100,PT2)) GOTO 10000
C
C
C
C **************************************************
C ****** ADD 2 POSITIVE OR 2 NEGATIVE NUMBERS ******
C **************************************************
	CARRY=0
	DO 110 I=1,99
	TEMP=STACK1(I,PT1)+STACK2(I,PT2)+CARRY
	CARRY=TEMP/BASE
110	STACK1(I,PT1)=TEMP-CARRY*BASE
C
C
C
120	IF (CARRY.EQ.0) RETURN
C
C
C
C ***** ERROR ******  OVERFLOW
	RETCD=2
	CALL ERRMSG (22)
	RETURN
C
C
C
C
C
C ***************************************************************
C ***** SUBTRACTION REQUIRED BECAUSE THE SIGNS ARE OPPOSITE *****
C ***************************************************************
10000	SW=STACK1(100,PT1)
C
C SUBTRACT ACCORDING TO VALUE OF SW (A-B OR B-A)
	DO 10100 I=1,99
	IF (SW.EQ.1) GOTO 10010
	STACK1(I,PT1)=STACK1(I,PT1)-STACK2(I,PT2)
	GOTO 10100
10010	STACK1(I,PT1)=STACK2(I,PT2)-STACK1(I,PT1)
C
C
C DETERMINE IF SUM RESULTED IN ANY 'NEGATIVE DIGITS'
10100	CONTINUE
	DO 10200 I=1,99
	K=100-I
	IF (STACK1(K,PT1).NE.0) GOTO 10250
10200	CONTINUE
	STACK1(100,PT1)=0
	RETURN
C
C
C
C
C WHEN CORRESPONDING DIGITS WHERE ADDED (OR SUBTRACTED) THE RESULT
C WAS NEGATIVE. FIRST WE SET SW TO THE SIGN OF THE RESULT (THE SIGN
C OF THE MOST SIGNIFICANT DIGIT).
10250	SW=0
	IF (STACK1(K,PT1).LT.0) SW=1
	CARRY=0
	DO 10300 I=1,K
	IF (SW.EQ.0) GOTO 10280
C
C
C ********************************
C ****** RESULT IS NEGATIVE ******
C ********************************
C
C GO THROUGHT EACH DIGIT, MAKE EACH ONE POSITIVE SINCE
C STACK1(100,PT1) WILL INDICATE THAT THE NUMBER IS NEGATIVE.
	TEMP=STACK1(I,PT1)+CARRY
	IF (TEMP.LE.0) GOTO 10270
C
C IF DIGIT IS POSITIVE, "BORROW" FROM NEXT HIGHEST DIGIT.
	STACK1(I,PT1)=BASE-TEMP
C
C SET BORROW INDICATOR.
	CARRY=1
	GOTO 10300
C
C DIGIT IS NEGATIVE SO CHANGE SIGN, CLEAR "BORROW" INDICATOR.
10270	STACK1(I,PT1)=-TEMP
	CARRY=0
	GOTO 10300
C
C
C
C
C ********************************
C ****** RESULT IS POSITIVE ******
C ********************************
10280	TEMP=STACK1(I,PT1)-CARRY
	IF (TEMP.GE.0) GOTO 10290
C
C IF DIGIT IS NEGATIVE, "BORROW" FROM NEXT HIGHEST DIGIT.
	STACK1(I,PT1)=TEMP+BASE
C
C SET "BORROW" INDICATOR
	CARRY=1
	GOTO 10300
C
C
C DIGIT IS POSITIVE SO RETAIN VALUE AND CLEAR CARRY INDICATOR
10290	STACK1(I,PT1)=TEMP
	CARRY=0
10300	CONTINUE
C
C
C
C SET SIGN OF RESULT, GO TO 120 TO CHECK FOR OVERFLOW.
	STACK1(100,PT1)=SW
	GOTO 120
	END