demo: huge number calculator and library
From: Robert Wagner (robert.deletethis_at_wagner.net)
Date: 07/31/04
- Next message: LX-i: "Re: Layout Hell-o"
- Previous message: docdwarf_at_panix.com: "Re: Layout Hell-o"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Date: Sat, 31 Jul 2004 00:36:41 GMT
* Calculator and Huge Number Library
*
* This is a demo of huge integer calculations. Want 10,000-digit numbers?
* The demo uses 200 digits -- 100 to the left and 100 to the right.
*
* The program can be used three ways:
*
* .. Executed from the command line, it prompts for a formula, calculates
* and displays the answer. Examples:
* 1+1
* ((17 / 3)+2.7183)*(5!)
* 2^.5
*
* .. Called by a program with a formula and optional values. Example:
* move '((17/3)+2)*(5!)' to my-formula
* call 'CALCPARS' using a, b, c, my-formula
* move c to a
* move 'a^.5' to my-formula
* call 'CALCPARS' using a, b, c, my-formula
* move c to the-answer
*
* .. Low-level functions called by a program. Example:
* move ... to a
* move ... to b
* call 'CALCADD' using a, b, c
* move c to the-answer
*
* Functions are +, -, *, /, ! and ^ (exponent)
*
* Micro Focus compile commands:
* cob -xg calc.cbl # executable to run from command line
* cob -zg calc.cbl # callable program (so)
* cob -xg yourprog ./calc.so # your program bound to above
*
$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
.
- Next message: LX-i: "Re: Layout Hell-o"
- Previous message: docdwarf_at_panix.com: "Re: Layout Hell-o"
- Messages sorted by: [ date ] [ thread ] [ subject ] [ author ]
Relevant Pages
|
