|
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.16 Sekunden
(vorverarbeitet)
¤
|
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.
|
