Quelle  hugeintegers-fi.cob   Sprache: Cobol

         identification division.
         program-id. CALC.
         author. Robert Wagner
         date-written. 07/29/04
      * Huge number function library.
      * Parses formula out of a string.
      * Runs three ways:
      * From command line -- type in formula
      * Call CALCPARS -- to parse and evaluate formula
      * Call CALCxxxx low-level functions
      *
      * Negative numbers are nines complement.
      * The left half contains the 'whole number' and the right
      * half contains the
      * fraction.
      *
      * Note that everything is relative to the size of 'huge'
      * below.
      * The program would read better if I could equate
      * 'mid' to 'length of huge / 2'. I couldn
      *'t find a way in Cobol 85.
         
         data division.
         working-storage section.
          01 huge typedef.
          05 a-digit occurs 200 pic 9(01).
          01 calcpars-variables.
          05 p binary pic s9(04).
          05 sp binary pic s9(04).
          05 value 'd' pic x(01).
          88 debug-mode value 'd'.
          01 the-stack.
          05 stack-entry occurs 10.
          10 stack-number huge.
          10 stack-operation pic x(01).
          01 typein pic x(128).
          01 x huge.
          01 y huge.
          01 z huge.
         
          01 calchuge-variables.
          05 i binary pic s9(04).
          05 j binary pic s9(04).
          05 k binary pic s9(04).
          05 l binary pic s9(04).
          05 power binary pic s9(04).
          05 factorial binary pic s9(04).
          05 temp-s binary pic s9(02).
          05 term pic 9(02).
          05 overflow-digit pic 9(01).
          05 two-digits pic 9(02).
          05 redefines two-digits.
          10 digit-1 pic 9(01).
          10 digit-2 pic 9(01).
          05 sign-count pic 9(01).
          01 d huge.
          01 temp-1 huge.
          01 temp-2 huge.
          01 temp-3 huge.
          01 temp-a huge.
          01 temp-b huge.
          01 shifter huge.
          01 e huge.
          01 exponent huge.
         
         linkage section
          01 a huge.
          01 b huge.
          01 c huge.
          01 input-string.
          05 input-byte occurs 128 indexed x-in pic x(01).
         
      * Compiler insists on this USING. There are no parms to main.
         PROCEDURE DIVISION using a, b, c, input-string.
         move low-values to typein
         perform until typein equal to spaces
         display 'Enter problem'
         accept typein
         move zeros to x, y, z
         
         call 'CALCPARS' using x, y, z, typein
         
         display 'the answer is: ' with no advancing
         call 'DISPC' using x, y, z
         end-perform
         stop run
         
         
         . entry 'CALCPARS' using a, b, c, input-string.
         move a to x
         move b to y
         move zeros to a, b, c
         move 1 to sp
         move zeros to stack-number (1)
         move '+' to stack-operation (1)
         set x-in to 1
         perform one-word until x-in greater than 128
         if sp not equal to 1
         display 'too many left parens'
         perform do-operation until sp = 1
         end-if
         move stack-number (1) to c
         
         goback
         
         . one-word.
         evaluate input-byte (x-in)
         when = '+' or '-' or '*' or '/' or '^' or '!'
         move input-byte (x-in) to stack-operation (sp)
         if input-byte (x-in) equal to '!'
         perform do-operation
         move space to stack-operation (sp)
         end-if
         when '0' thru '9'
         when '.'
         perform pickup-number
         perform process-number
         when '('
         perform bump-sp
         move zeros to stack-number (sp)
         move '+' to stack-operation (sp)
         when ')'
         perform do-operation
         when 'a'
         move x to b
         perform process-number
         when 'b'
         move y to b
         perform process-number
         when space
         continue
         when other
         set i to x-in
         display 'invalid input ' input-byte (x-in) ' col ' i
         end-evaluate
         set x-in up by 1
         . pickup-number.
         move zeros to b
         compute p = length of huge / 2
         perform until (input-byte (x-in) less '0' or greater '9') and
         input-byte (x-in) not equal to '.'
         if input-byte (x-in) equal to '.'
         compute p = (length of huge / 2) + 1
         else
         if p equal to (length of huge / 2)
         call 'CALCSHL' using a, b, c
         move input-byte (x-in) to a-digit in b (length of huge / 2)
         else
         move input-byte (x-in) to a-digit in b (p)
         add 1 to p
         end-if
         end-if
         set x-in up by 1
         end-perform
         set x-in down by 1
         . process-number.
         perform bump-sp
         move b to stack-number (sp)
         perform do-operation
         . do-operation.
         if debug-mode
         if stack-operation (sp) not equal to '!'
         perform dec-sp
         end-if
         move stack-number (sp) to c
         perform display-c
         display stack-operation (sp)
         if stack-operation (sp) not equal to '!'
         perform bump-sp
         move stack-number (sp) to c
         perform display-c
         end-if
         end-if
         
         move stack-number (sp) to b
         if stack-operation (sp) not equal to '!'
         perform dec-sp
         move stack-number (sp) to a
         end-if
         evaluate stack-operation (sp)
         when '+'
         call 'CALCADD' using a, b, c
         when '-'
         call 'CALCSUB' using a, b, c
         when '*'
         call 'CALCMUL' using a, b, c
         when '/'
         call 'CALCDIV' using a, b, c
         when '^'
         call 'CALCEXP' using a, b, c
         when '!'
         call 'CALCFAC' using a, b, c
         when other
         move b to c
         end-evaluate
         move c to stack-number (sp)
         
         if debug-mode
         display '='
         perform display-c
         end-if
        bump-sp.
         if sp less than 10
         add 1 to sp
         else
         display 'stack overflow'
         end-if
        dec-sp.
         if sp greater than 1
         subtract 1 from sp
         else
         display 'too many right parens'
         end-if
        display-c.
         if a-digit in c (1) equal to 9
         call 'CALCNEG' using a, b, c
         display '-' with no advancing
         end-if
         perform varying i from 1 by 1 until
         a-digit in c (i) not = zero or i > 99
         continue
         end-perform
         perform varying i from i by 1 until i > ((length of huge /
          2) + 20) or
         (i equal to ((length of huge / 2) + 1) and
         c((length of huge / 2) + 1:length of huge / 2) equal to zero)
         display a-digit in c (i) with no advancing
         if i equal to (length of huge / 2)
         display '.' with no advancing
         end-if
         end-perform
         display space
        end-calcpars
         
         
      * Begin calchuge.
        entry 'CALCADD' using a, b, c.
         perform compute-a-plus-b
         goback
        entry 'CALCSUB' using a, b, c.
         perform compute-a-minus-b
         goback
        entry 'CALCMUL' using a, b, c.
         perform compute-a-times-b
         goback
        entry 'CALCDIV' using a, b, c.
         perform compute-a-divided-by-b
         goback
        entry 'CALCEXP' using a, b, c.
         if b(1:(length of huge / 2) - 2) equal to zero and
         b((length of huge / 2) + 1:length of huge / 2) equal to zero
         perform compute-a-ipower-b
         else
         perform compute-a-power-b
         end-if
         goback
        entry 'CALCFAC' using a, b, c.
         perform compute-b-factorial
         goback
        entry 'CALCNEG' using a, b, c.
         perform flip-sign-c
         goback
        entry 'CALCSHR' using a, b, c.
         perform shift-b-right
         goback
        entry 'CALCSHL' using a, b, c.
         perform shift-b-left
         goback
        entry 'DISPC' using a, b, c.
         perform display-c
         goback
         
         compute-a-plus-b.
         move zero to overflow-digit
         if 9 not = a-digit in b (1) and a-digit in a (1)
         move 0 to overflow-digit
         perform add-operation
         else
         if 9 = a-digit in b (1) and a-digit in a (1)
         move 1 to overflow-digit
         perform add-operation
         else
         perform flip-sign-b
         perform compute-a-minus-b
         end-if
        add-operation.
         perform varying i from length of huge by -1 until i less
          than 1
         compute temp-s =
         a-digit in a (i) + a-digit in b (i) + overflow-digit
         if temp-s less than 10
         move temp-s to a-digit in c (i)
         move 0 to overflow-digit
         else
         subtract 10 from temp-s giving a-digit in c (i)
         move 1 to overflow-digit
         end-if
         end-perform
         
        compute-a-minus-b.
         move zero to overflow-digit
         if b greater than a
         move 1 to overflow-digit
         end-if
         perform varying i from length of huge by -1 until i less
          than 1
         compute temp-s =
         a-digit in a (i) - a-digit in b (i) - overflow-digit
         if temp-s less than zero
         add 10 to temp-s giving a-digit in c (i)
         move 1 to overflow-digit
         else
         move temp-s to a-digit in c (i)
         move 0 to overflow-digit
         end-if
         end-perform
         
        compute-a-times-b.
         perform normalize-sign-in
         move zeros to d
         perform varying i from length of huge by -1 until i less
          than 1
         if a-digit in b (i) not equal to zero
         compute k = i + (length of huge / 2)
         perform varying j from length of huge by -1 until j less
          than 1
         if a-digit in a (j) not equal to zero and
         k not less 1 and not greater length of huge
         compute two-digits =
         a-digit in a (j) * a-digit in b (i)
         perform add-two-digits
         end-if
         subtract 1 from k
         end-perform
         end-if
         end-perform
         move d to c
         perform normalize-sign-out
         
        compute-a-divided-by-b.
         perform normalize-sign-in
         compute k = length of huge / 2
         perform until b not less than a or k = 1
         perform shift-b-left
         subtract 1 from k
         end-perform
         move zeros to d
         perform until k > length of huge
         perform until b greater than a or b = zeros
         move 1 to two-digits
         perform add-two-digits
         perform compute-a-minus-b
         move c to a
         end-perform
         perform shift-b-right
         add 1 to k
         end-perform
         move d to c
         perform normalize-sign-out
         
         
        compute-a-power-b.
      * Computing a^b
         move a to temp-a
         move b to temp-b
         if a-digit in a (1) equal to 9 or a equal to zero
         move zero to c
         exit paragraph
         end-if
      * Get the exponent by repeatedly dividing by e
         move zero to e, exponent
         move '27182818284590452353602874' to e(length of huge / 2:26)
         perform until temp-a not greater than e
         move temp-a to a
         move e to b
         perform compute-a-divided-by-b
         move c to temp-a
         move exponent to a
         move zero to b
         move 1 to a-digit in b (length of huge / 2)
         perform compute-a-plus-b
         move c to exponent
         end-perform
      * Compute base e logarithm of the mantissa
      * ln(x) = perform varying t from 1 by 2 until delta = zero
      * or t > 90
      * compute ln = ln + ((2 / t) * (((x - 1) / (x + 1)) ^ t))
      * where 0 < x < e
         move temp-a to a
         move zero to b
         move 1 to a-digit in b (length of huge / 2)
         perform compute-a-minus-b
         move c to temp-2
         perform compute-a-plus-b
         move temp-2 to a
         move c to b
         perform compute-a-divided-by-b
         move c to temp-2 *> save (x - 1) / (x + 1)
         move zero to temp-3
         move all '1' to b
         perform varying term from 1 by 2 until
         b(1:(length of huge / 2) + 16) = zero or term > 90 or
         b(1:(length of huge / 2) + 16) = all '9'
         move zero to a, b
         move 2 to a-digit in a (length of huge / 2)
         move term to b((length of huge / 2) - 1:2)
         perform compute-a-divided-by-b
         move c to temp-1
         move temp-2 to a
         move zero to b
         move term to b((length of huge / 2) - 1:2)
         perform compute-a-ipower-b
         move temp-1 to a
         move c to b
         perform compute-a-times-b
         move temp-3 to a
         move c to b
         perform compute-a-plus-b
         move c to temp-3
         end-perform
      * Add the exponent giving ln(a)
         move c to a
         move exponent to b
         perform compute-a-plus-b
      * Multiply by b
         move c to a
         move temp-b to b
         perform compute-a-times-b
         move c to temp-a
      * e^x = perform varying t from 1 by 1 until delta = zero or
      * t > 90
      * compute exp = exp + ((x ^ t) / t!)
      * add 1 to exp
      * Note that ln(a) will be negative when a < 1. In that case,
      * this is
      * an alternating series because n^t will be negative half
      * the time.
         move zero to b
         move 1 to a-digit in b (length of huge / 2)
         move b to temp-3
         perform varying term from 1 by 1 until
         b(1:(length of huge / 2) + 16) = zero or term > 90
         move temp-a to a
         move zero to b
         move term to b((length of huge / 2) - 1:2)
         perform compute-a-ipower-b
         move c to temp-1
         move zero to b
         move term to b((length of huge / 2) - 1:2)
         perform compute-b-factorial
         move temp-1 to a
         move c to b
         perform compute-a-divided-by-b
         move temp-3 to a
         move c to b
         perform compute-a-plus-b
         move c to temp-3
         end-perform
      * Discard meaningless digits
         if c ((length of huge / 2) + 17:(length of huge / 2) - 16)
         not equal to zero
         move c to a
         move zero to b
         move 5 to a-digit in b ((length of huge / 2) + 17)
         perform compute-a-plus-b
         move zero to c((length of huge / 2) + 17:(length of huge /
          2) - 16)
         end-if
         if c((length of huge / 2) + 1:6) equal to zero and
         c(1:(length of huge / 2)) not equal to zero
         move zero to c((length of huge / 2) + 7:(length of huge / 2)
          - 6)
         end-if
         
      * Integer exponent 1-99
        compute-a-ipower-b.
         move b((length of huge / 2) - 1:2) to two-digits
         move two-digits to power
         move zeros to b
         move 1 to a-digit in b (length of huge / 2)
         perform power times
         perform compute-a-times-b
         move c to b
         end-perform
         if c((length of huge / 2) + 1:10) equal to zero and
         c(1:(length of huge / 2)) not equal to zero
         move zero to c((length of huge / 2) + 11:(length of huge /
          2) - 10)
         end-if
         
        compute-b-factorial.
         move b((length of huge / 2) - 1:2) to two-digits
         move two-digits to power
         move zeros to a, b
         move 1 to a-digit in a (length of huge / 2),
         a-digit in b (length of huge / 2)
         perform varying factorial from 1 by 1 until factorial > power
         move factorial to two-digits
         move two-digits to b((length of huge / 2) - 1:2)
         perform compute-a-times-b
         move c to a
         end-perform
         
        flip-sign-a.
         inspect a converting '0123456789'
         to '9876543210'
        flip-sign-b.
         inspect b converting '0123456789'
         to '9876543210'
        flip-sign-c.
         inspect c converting '0123456789'
         to '9876543210'
         
        shift-b-right.
         move b(1:length of huge - 1) to shifter(2:length of huge - 1)
         move zero to shifter(1:1)
         move shifter to b
        shift-b-left.
         move b(2:length of huge - 1) to shifter(1:length of huge - 1)
         move zero to shifter(length of huge:1)
         move shifter to b
         
        add-two-digits.
         move k to l
         perform until two-digits = zero or l < 1
         add a-digit in d (l) to two-digits
         move digit-2 to a-digit in d (l)
         move digit-1 to digit-2
         move 0 to digit-1
         subtract 1 from l
         end-perform
        normalize-sign-in.
         move zero to sign-count
         if a-digit in a (1) equal to 9
         add 1 to sign-count
         perform flip-sign-a
         end-if
         if a-digit in b (1) equal to 9
         add 1 to sign-count
         perform flip-sign-b
         end-if
        normalize-sign-out.
         if sign-count equal to 1
         perform flip-sign-c
         end-if