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