Quellcode-Bibliothek

^© Kompilation durch diese Firma

[Weder Korrektheit noch Funktionsfähigkeit der Software werden zugesichert.]

Datei: hugeintegers-fi.cob Sprache: Cobol

Original von: verschiedene^©

         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

¤ Dauer der Verarbeitung: 0.6 Sekunden (vorverarbeitet) ¤

Download des Quellennavigators
Download des sprechenden Kalenders
in der Quellcodebibliothek suchen

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung ist noch experimentell.