Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

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 *    SUBROUTINE  MULDIV (PT1,PT2,RETCD,BASE)     *
C *                                                *
C **************************************************
C
C
C  SUBROUTINE MULDIV PERFORMS MULTIPLE PRECISION DIVISION
C
C
C
C  ARGUMENTS: (PT1,PT2,RETCD)
C
C  PLACES STACK1( ,PT1)/STACK2( ,PT2) INTO STACK1( ,PT1)
C
C  STACK 2 IS NOT CLEANED UP BY THIS ROUTINE
C
C  ERROR RETURN		1 = NORMAL
C			2 = ERROR
C
C
C
C ENTRY INDICATES THE BASE: 8, 10, OR 16
C
C
C
C
C  MODIFY CODES: M3, M10
C
C
C
C
C MULDIV CALLS ERRMSG TO PRINT ERROR MESSAGES.
C
C
C
C
C MULDIV IS CALLED BY CALBIN
C
C
C
C
C  VARIABLE    USE
C
C    ANSWER    HOLDS QUOTIENT
C    BASE      HOLDS THE BASE: 8, 10, OR 16
C    CARRY     USED TO "BORROW" WHEN SUBTRACTING
C    DIVPT     POINTS TO HIGHEST (NON-ZERO) DIGIT OF DIVISOR.
C    I,M,K,L   TEMPORARY VALUES.
C    NPT       HOLDS POSITION OF HIGHEST (NON-ZERO) DIGIT OF DIVIDEND.
C    PT1       POINTER TO STACK1 ELEMENT (DIVIDEND)
C    PT2       POINTER TO STACK2 ELEMENT (DIVISOR)
C    RETCD     RETURN CODE: 1=O.K., 2=ERROR.
C
C
C
C
C
C
	SUBROUTINE MULDIV (PT1,PT2,RETCD,BASE)
	INTEGER*2 RETCD,BASE,DIVPT,NPT,CARRY
	INTEGER*2 ST1PT,ST2PT,ST1LIM,ST2LIM,PT1,PT2
	INTEGER*2 ST1TYP(40),ST2TYP(40)
	INTEGER*2 I,M,K,L
C
	LOGICAL*1 ANSWER(100)
	LOGICAL*1 STACK1(100,40),STACK2(100,40)
C
	COMMON /STACK/STACK1,STACK2,ST1PT,ST2PT,ST1TYP,ST2TYP,
     ;          ST1LIM,ST2LIM
C
C
C
C
C
C  SET DEFAULT RETURN CODE AND ZERO ANSWER
	RETCD=1
	DO 110 I=1,100
110	ANSWER(I)=0
C
C
C  DETERMINE SIGN OF ANSWER
	IF (STACK1(100,PT1)+STACK2(100,PT2).EQ.1)ANSWER(100)=1
C
C
C  FIND HIGH ORDER NON-ZERO DIGIT OF DIVISOR (HELD BY DIVPT)
	DO 140 I=1,99
	DIVPT=100-I
	IF (STACK2(DIVPT,PT2).NE.0) GOTO 150
140	CONTINUE
C
C
C  DIVISOR IS ZERO, PRINT OUT APPROPRIATE ERROR MESSAGE
	RETCD=2
	CALL ERRMSG (23)
	RETURN
C
C
C  FIND STARTING NON-ZERO DIGIT OF DIVIDEND (HELD BY NPT)
150	DO 170 I=1,99
	NPT=100-I
	IF (STACK1(NPT,PT1).NE.0) GOTO 200
170	CONTINUE
C
C
C  ANSWER IS ZERO
	GOTO 10000
C
C
C
C
C
C ************************************************
C ****** FIND OUT WHERE TO SUBTRACT DIVISOR ******
C ************************************************
C
200	IF (NPT.LT.DIVPT) GOTO 10000
C
C M POINTS TO A DIGIT OF DIVIDEND ALIGNED WITH THE LOW ORDER DIGIT OF
C DIVISOR.
	M=NPT-DIVPT+1
C
C K INDEXES DIVIDEND FROM HIGH ORDER END.
	K=NPT
C
C L INDEXES DIVISOR FROM HIGH ORDER END.
	L=DIVPT
	DO 250 I=1,DIVPT
	IF (STACK2(L,PT2).EQ.STACK1(K,PT1)) GOTO 240
C
C WHEN COMPARING DIGITS OF DIVISOR AND DIVIDEND, IF THE DIVISOR'S
C DIGIT IS SMALLER AND ALL PREVIOUS WERE EQUAL,
C THEN WE GO TO 300 TO SUBTRACT OFF THE DIVISOR.
	IF (STACK2(L,PT2).LT.STACK1(K,PT1)) GOTO 300
C
C OTHERWISE THOSE DIGITS OF THE DIVIDEND REPRESENT A LARGER
C NUMBER. IF THE NUMBER OF DIGITS OF THE DIVISOR IS GREATER
C THAN OR EQUAL TO DIVIDEND THEN THE QUOTIENT IS 0 AND THE
C REMAINDER IS THE DIVIDEND. (GO TO 10000)
	IF (NPT.LT.DIVPT+1) GOTO 10000
C
C OTHERWISE SHIFT THE POSITION OF THE DIVISOR BY 1.
	M=M-1
	GOTO 300
C
C
C K INDEXES DIVIDEND
C L INDEXES DIVISOR
240	K=K-1
	L=L-1
250	CONTINUE
C
C
C
C
C **************************************
C ****** SUBTRACT OFF THE DIVISOR ******
C **************************************
300	CONTINUE
C
C K POINTS TO LOW ORDER DIGIT WHERE SUBTRACTION TAKES PLACE,
C CARRY TAKES CARE OF "BORROWS"
	K=M-1
	CARRY=0
	DO 350 I=1,DIVPT
	K=K+1
	L=STACK1(K,PT1)-STACK2(I,PT2)-CARRY
	IF (L.GE.0) GOTO 325
C
C IF SUBTRACTION RESULTS IN A "NEGATIVE DIGIT", ADD BASE AND SET CARRY
C INDICATOR.
	CARRY=1
	L=BASE+L
	GOTO 340
C
C RESULT OF SUBTRACTION IS A POSITIVE NUMBER, SO
C CLEAR CARRY INDICATOR.
325	CARRY=0
340	STACK1(K,PT1)=L
350	CONTINUE
	IF(CARRY.EQ.1) STACK1(K+1,PT1)=STACK1(K+1,PT1)-1
C
C
C THE QUOTIENT (ANSWER(M)) COUNTS THE NUMBER OF SUBTRACTIONS.
	ANSWER(M)=ANSWER(M)+1
C
C
C RESET THE POINTER TO THE HIGH ORDER NON-ZERO DIGIT OF THE
C DIVIDEND IF NECESSARY.
370	IF (STACK1(NPT,PT1).NE.0) GOTO 200
	NPT=NPT-1
	IF (NPT.EQ.0) GOTO 10000
	GOTO 370
C
C
C
C
C ***************************
C ******  COPY ANSWER  ******
C ***************************
10000	DO 10010 I=1,100
10010	STACK1(I,PT1)=ANSWER(I)
	RETURN
	END