Quelle  hugeintegers.cob

$SET SOURCEFORMAT"FREE"
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



 
[ Go to Top of Page ]
  
COBOL NuTrak Ad



Local COBOL User Groups
COBOL User Group Check out the list of local COBOL user groups from around the world and join a user group near you.


Call for User Group Leaders!
COBOL User Groups Get Involved! We are looking for user group leaders to help organize and coordinate a local COBOL user group.

Join COBUG!
COBOL User Groups Become a part of the COBUG community today. Join Now ...


COBOL Forums
COBOL Forum Try our forums for help!
Let the COBUG members help you. Post your issues!


COBOL Job Resources
COBOL Jobs Here are references to a wealth of job resources, including job listing sites, resume preparation, and interview questions.


Job and Resume Matchmaker!
COBOL Jobs Employers submit your COBOL job openings. Job seekers submit your resumes.

COBOL  (c) Information Computing Services. All Rights Reserved.  COBOL