SUBROUTINE MULADD (PT1,PT2,RETCD,ENTRY) C COPYRIGHT (C) 1983 GLENN EVERHART C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY. INCLUDE 'VKLUGPRM.FTN' C PARAMETER RRW = 32 C PARAMETER RCL = 32 C RRW=MAX REAL ROWS C RCL=MAX REAL COLS C RRW MUST BE 1 LARGER TO HANDLE 1ST 27 VARIABLES IN AVBLS C VBLS AND TYPE DIMENSIONED RRW,RCL 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 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