|
DataMuseum.dkPresents historical artifacts from the history of: RegneCentralen GIER Computer |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RegneCentralen GIER Computer Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 39564 (0x9a8c)
Description: Bits:30000581 Demon 1E Algol III 28/8-70
Types: 8-hole paper tape
Notes: Gier Text, Has10
-1- DEMON-1E
Demonstration Program for GIER - ALGOLprogram
begin
_____
procedure translate to ALGOL III (tast,tasttegn,tegn,skrvtegn,
_________
skrv,skrvtekst,skrvvr);
integer procedure tast,tasttegn,tegn,skrvtegn,skrv,skrvtekst,skrvvr;
_______ _________
begin integer n;
_____ _______
integer procedure skrvml(n);
_______ _________
integer n;
_______
begin integer i;
_____ _______
for i:=1 step 1 until n do writechar(0)
___ ____ _____ __
end;
___
comment[ s t o p ] -2-
_______
DEMON-1E
Program DEMON-1E.
begin comment GIER DEMONSTRATION PROGRAM-1E;
_____ _______
boolean newnim, newmap, newlineq, newprime, newlanu;
_______
integer linerest, oldrand, type;
_______
switch TYPE := NIM, MAP, LINEQ, PRIME, LANU, FINISH;
______
procedure NEWPAGE;
_________
begin
_____
for linerest := linerest - 1 while linerest _ -9 do skrvvr;
___ _____ > __
linerest := 62
end NEWPAGE;
___
procedure LINE;
_________
begin
_____
linerest := linerest - 1;
skrvvr;
if linerest < 0 then NEWPAGE
__ ____
end LINE;
___
procedure SHIFT(n);
_________
value n;
_____
integer n;
_______
if linerest < n then NEWPAGE;
__ ____
procedure CHECKLINE;
_________
if tegn = 64 ∨ tegn = 192 then
__ ____
begin
_____
linerest := linerest - 1;
SHIFT(0)
end CHECKLINE;
___
integer procedure RANDOM(n);
_______ _________
value n;
_____
integer n;
_______
begin
_____
real y, MOD;
____
MOD := 32768;
y := oldrand⨯6859;
oldrand := y - MOD⨯entier(y/MOD);
RANDOM := 1 + entier(n⨯oldrand/MOD)
end RANDOM;
___
START: oldrand := 999;
linerest := 65;
newnim := newmap := newlineq := newprime := newlanu := true;
____
skrvtegn(62);
comment
_______
-3- DEMON-1
E
;
skrvtekst(|<
<
GIER DEMONSTRATION PROGRAM 1E
The program can be used in 5 different ways:
1. Playing the game: NIM.
2. Printing of random maps.
3. Solution of random linear equations.
4. Calculation of prime numbers.
5. Calculation of large numbers.
6 gives end of program.
Please write your initials here:|);
>
linerest := linerest - 11;
begin
_____
integer i, j, sum;
_______
sum := tasttegn + tasttegn;
for i := 1 step 1 until sum do j := RANDOM(1)
___ ____ _____ __
end of advance of random procedure;
___
RESTART: LINE; LINE;
SHIFT(10);
skrvtekst(|<Select program type 1-5 (6 gives program stop): |);
< >
type := tasttegn;
LINE; LINE;
go_to TYPE[type];
__ __
go_to RESTART;
__ __
NIM: SHIFT(10);
skrvtekst(|<Type 1. Playing the game: NIM|);
< >
LINE; LINE;
begin comment NIM-block;
_____ _______
boolean longtext, winmessage, wrongmessage, loosemessage, present;
_______
integer M, G, N, g, n, t, gno, remove, fact, R, boolsum, aritsum, ask,
_______
GMAX, nmax;
longtext := newnim;
comment
_______
-4- DEMON-1
E
;
if newnim then
__ ____
begin
_____
SHIFT(10);
skrvtekst(|<
<
RULES OF THE GAME NIM
The game starts with a random selection of G groups of matches. Each group
contains a maximum of M matches. The value of M is written as 2∧N - 1, and you
|
must specify N and G. We shall then alternatingly remove matches from the group
s.
He who removes the last match (or matches) has won. In each move only one group
must be touched, and at least one match must be removed from that group.
|);
>
linerest := linerest - 7
end if newnim;
___
AGAIN: SHIFT(4);
LINE;
winmessage := wrongmessage := loose message := false;
_____
skrvtekst(|<Specify N: |);
< >
N := tast;
if N > 9 then N := 9;
__ ____
LINE;
CHECKLINE;
M := 2∧N - 1;
|
ask := 0;
skrvtekst(|<Specify G: |);
< >
G := tast;
if G > 15 then G := 15;
__ ____
LINE;
CHECKLINE;
LINE; LINE;
begin comment inner NIM-block;
_____ _______
integer array GROUP[1:G], SUM[1:N], BITS[1:G, 1:N];
_______ _____
procedure PRINTGROUPS;
_________
for g := 1 step 1 until G do skrv(|-ndd|, GROUP[g]);
___ ____ _____ __ < >
procedure DISPLAY BITS(g);
_________
value g;
_____
integer g;
_______
begin
_____
R := GROUP[g];
fact := 2;
comment
_______
-5- DEMON-1E
;
for n := 1 step 1 until N do
___ ____ _____ __
begin
_____
present := R _ fact⨯fact | R;
: =
if present then R := R - fact _ 2;
__ ____ :
BITS[g,n] := if present then 1 else 0;
__ ____ ____
fact := fact⨯2
end for n
___
end DISPLAY BITS;
___
procedure FIND SUM;
_________
begin
_____
aritsum := 0;
for g := 1 step 1 until G do aritsum := aritsum + GROUP[g];
___ ____ _____ __
for n := 1 step 1 until N do
___ ____ _____ __
begin
_____
boolsum := 0;
for g := 1 step 1 until G do boolsum := boolsum + BITS[g,n];
___ ____ _____ __
SUM[n] := boolsum - boolsum _ 2⨯2
:
end;
___
boolsum := 0;
fact := 1;
for n := 1 step 1 until N do
___ ____ _____ __
begin
_____
boolsum := boolsum + SUM[n]⨯fact;
fact := 2⨯fact
end for n
___
end FIND SUM;
___
for g := 1 step 1 until G do
___ ____ _____ __
begin
_____
GROUP[g] := RANDOM(M);
DISPLAY BITS(g)
end for g;
___
FIND SUM;
SHIFT(4);
skrvtekst(|<Here are the groups:|);
< >
LINE;
skrvtekst(|<Group no.: |);
< >
for g := 1 step 1 until G do skrv(|-ndd|, g);
___ ____ _____ __ < >
LINE;
skrvtekst(|<Number of matches:|);
< >
PRINTGROUPS;
BB: SHIFT(4);
comment
_______
-6- DEMON-1
E
;
skrvtekst(|<
<
If you wish to make the first move, please write a figure 1 here, otherwise
a figure 2: |);
>
linerest := linerest - 2;
t := tasttegn;
if t | 1 ∧ t | 2 then go_to BB;
__ = = ____ __ __
if t = 2 then go_to II;
__ ____ __ __
GG: SHIFT(4);
LINE;
skrvtekst(if longtext then
__ ____
|<Write here the number of the group from which you will remove matches: |
< >
else |<Choose your group: |);
____ < >
CC: gno := tast;
CHECKLINE;
LINE;
if gno < 1 ∨ gno > G then
__ ____
begin
_____
skrvtekst(
|<Sorry, but the number is too |, if gno < 1 then |<low.| else |<high.|);
< > __ ____ < > ____ < >
DD: LINE;
skrvtekst(|< Try again here: |);
< >
go_to CC
__ __
end if out of range;
___
if GROUP[gno] = 0 then
__ ____
begin
_____
skrvtekst(|<Sorry, but this group is empty.|);
< >
go_to DD
__ __
end if empty group;
___
remove := GROUP[gno];
if remove | 1 then
__ = ____
begin
_____
SHIFT(4);
skrvtekst(if longtext then
__ ____
|<And the number of matches you want to remove: | else |<And the number: |);
< > ____ < >
EE: remove := tast;
CHECKLINE;
LINE;
comment
_______
-7- DEMON-
1E
;
if remove < 1 then
__ ____
begin
_____
skrvtekst(|<You must remove some matches. Try again: |);
< ____ >
go_to EE
__ __
end;
___
if remove > GROUP[gno] then
__ ____
begin
_____
skrvtekst(
|<There are not so many in the group. You are removing the whole group.|);
< __ >
LINE;
remove := GROUP[gno]
end if too many
___
end if more than one;
___
GROUP[gno] := GROUP[gno] - remove;
if longtext then longtext := false;
__ ____ _____
DISPLAY BITS(gno);
FIND SUM;
II: if boolsum | 0 then
__ = ____
begin
_____
SHIFT(4);
if winmessage ∧ -, wrongmessage then
__ ____
begin
_____
skrvtegn(29);
skrvtekst(|<That was wrong. You cannot win now.|);
< >
FF: loosemessage := wrongmessage := true;
____
skrvtegn(62);
LINE
end of blunder;
___
if loosemessage then
__ ____
begin
_____
ask := ask + 1;
if ask _ 3⨯3 = ask then
__ : ____
begin
_____
SHIFT(4);
skrvtekst(
|<If you want to give up the game, then write a 1 here: |);
< >
t := tasttegn;
LINE;
if t = 1 then go_to ASK FOR MORE
__ ____ __ __
end if third time;
___
comment
_______
-8- DEMON-1E
;
go_to GIERMOVE
__ __
end;
___
skrvtegn(29);
skrvtekst(|<You cannot win this game.|);
< >
go_to FF
__ __
end if boolsum | 0;
___ =
if aritsum = 0 then
__ ____
begin
_____
SHIFT(4);
skrvtekst(|<You have won. Congratulations.|);
< >
go_to ASK FOR MORE
__ __
end if finished;
___
if -, winmessage then
__ ____
begin
_____
SHIFT(4);
winmessage := true;
____
skrvtegn(29);
skrvtekst(|<If you play correctly, you may win this game.|);
< >
skrvtegn(62);
LINE
end if not winmessage;
___
GMAX := GROUP[1];
gno := 1;
for g := 2 step 1 until G do
___ ____ _____ __
begin
_____
if GROUP[g] > GMAX then
__ ____
begin
_____
GMAX := GROUP[g];
gno := g
end
___
end search of largest group;
___
remove := 1;
JJ: GROUP[gno] := GROUP[gno] - remove;
SHIFT(4);
if GROUP[gno] > 0 then
__ ____
begin
_____
skrvtekst(|<I now remove|);
< >
skrv(|-ndd|, remove);
< >
comment
_______
-9- DEMO
N-1E
;
skrvtekst(|< from group no.|)
< >
end group not empty
___
else
____
skrvtekst(|<I now remove the entire group no.|);
< >
skrv(|-ndd|, gno);
< >
skrvtekst(|<. The groups now contain:|);
< >
LINE;
LINE;
PRINTGROUPS;
DISPLAY BITS (gno);
FIND SUM;
if aritsum > 0 then go_to GG;
__ ____ __ __
SHIFT(4);
LINE;
skrvtekst(|<You have lost.|);
< >
ASK FOR MORE: LINE;
newnim := false;
_____
HH: skrvtekst(|<
<
If you wish to try again, please write a figure 1 here, otherwise a figure 2: |)
>
;
linerest := linerest - 1;
t := tasttegn;
if t | 1 ∧ t | 2 then go_to HH;
__ = = ____ __ __
LINE; LINE;
go_to if t = 1 then AGAIN else RESTART;
__ __ __ ____ ____
GIERMOVE: for g := 1 step 1 until G do
___ ____ _____ __
begin
_____
if boolsum = GROUP[g] then
__ ____
begin
_____
remove := boolsum;
gno := g;
go_to JJ
__ __
end if remove whole group
___
end for g;
___
for n := N step -1 until 1 do
___ ____ _____ __
begin
_____
if SUM[n] = 1 then
__ ____
begin
_____
nmax := n;
comment
_______
-10- DEMON
-1E
;
go_to KK
__ __
end hit
___
end for n;
___
KK: for g := 1 step 1 until G do
___ ____ _____ __
begin
_____
if BITS[g, nmax] = 1 then
__ ____
begin
_____
gno := g;
remove := 0;
fact := 1;
for n := 1 step 1 until nmax do
___ ____ _____ __
begin
_____
if SUM[n] = 1 then
__ ____
remove := remove + (if BITS[gno, n] = 1 then fact else - fact)
__ ____ ____
;
fact := fact⨯2
end for n;
___
go_to JJ
__ __
end if hit Bits
___
end for g;
___
go_to HH
__ __
end inner NIM-block
___
end NIM;
___
MAP:
begin comment MAP-block;
_____ _______
boolean red, even;
_______
integer a, amin, amax, b, bs, fh, fhmin, fhmax, fv, fvmin, fvmax, h, hs,
_______
k, n, ncon, nmap, p, p2, p3, q, r, r1, r2, s, s1, s2, spr;
real d, dmin, e, f, g, j, v;
____
SHIFT(10);
skrvtekst(|<Type 2. Printing of random maps.|);
< >
LINE; LINE;
if newmap then
__ ____
begin
_____
SHIFT(18);
comment
_______
-11- DEMON-1
E
;
skrvtekst(|<
<
The following parameters are used in this program:
Typical values:
nmap: Number of maps. 1
h: Height of maps. 60
b: Breadth of maps. 80
hs: Height of submap. 15
bs: Breadth of submap. 20
ncon: Number of countries per submap. 1
fh: Horizontal scale factor. 1 - 5
Minimum: fhmin, maximum: fhmax.
fv: Vertical scale factor. 1 - 5
Minimum: fvmin, maximum: fvmax.
a: Rotation angle. 45
Minimum: amin, maximum: amax.
spr: Spread factor: Minimum 1, maximum 10. 1
|);
>
linerest := linerest - 16;
newmap := false
_____
end if newmap;
___
LL: LINE;
SHIFT(5);
skrvtekst(|<
<
Specify the parameters:
nmap h b hs bs ncon fhmin fhmax fvmin fvmax amin amax spr
|);
>
nmap := tast; h := tast; b := tast;
hs := tast; bs := tast; ncon := tast;
fhmin := tast; fhmax := tast; fvmin := tast;
fvmax := tast; amin := tast; amax := tast;
spr := tast;
r1 := h _ hs;
:
s1 := b _ bs;
:
p2 := r1⨯s1⨯ncon;
linerest := linerest - 3;
LINE;
for n := 1 step 1 until nmap do
___ ____ _____ __
begin comment inner MAP-block;
_____ _______
integer array cx, cy, fh, fv[1:p2];
_______ _____
array cosv, sinv[1:p2];
_____
comment
_______
-12- DEMON-1
E
;
p := 0;
for r := 1 step 1 until r1 do
___ ____ _____ __
for s := 1 step 1 until s1 do
___ ____ _____ __
for q := 1 step 1 until ncon do
___ ____ _____ __
begin
_____
p := p+1;
cx[p] := (s-1)⨯bs + bs_2 + (RANDOM(bs) - bs_2)_spr;
: : :
cy[p] := (r-1)⨯hs + hs_2 + (RANDOM(hs) - hs_2)_spr;
: : :
fh[p] := fhmin + RANDOM(fhmax-fhmin) - 1;
if fh[p] < 1 then fh[p] := 1;
__ ____
fv[p] := fvmin + RANDOM(fvmax-fvmin) - 1;
if fv[p] < 1 then fv[p] := 1;
__ ____
v := 3.14159265/180⨯(amin + RANDOM(amax-amin));
cosv[p] := cos(v);
sinv[p] := sin(v)
end for q, s, and r;
___
SHIFT(h+3);
LINE;
skrvtegn(62);
red := false;
_____
for r := 1 step 1 until h do
___ ____ _____ __
begin
_____
for s := 1 step 1 until b do
___ ____ _____ __
begin
_____
dmin := 110 5;
for p := 1 step 1 until p2 do
___ ____ _____ __
begin
_____
e := cx[p];
f := cy[p];
g := cosv[p];
j := sinv[p];
d := (((e-s)⨯g - (f-r)⨯j)/fv[p])∧2
|
+ (((e-s)⨯j + (f-r)⨯g)/fh[p])∧2;
|
if d < dmin then
__ ____
begin
_____
dmin := d;
p3 := p
end if lower distance
___
end for p;
___
p3 := p3 - 1;
p3 := p3 - p3 _ 35⨯35 + 1;
:
comment
_______
-13- DEMON-1
E
;
even := p3 = p3 _ 2⨯2;
:
if p3 > 9 then
__ ____
p3 := if p3 < 19 then p3 + 39
__ ____
else
____
if p3 < 28 then p3 + 14 else p3 - 10;
__ ____ ____
if even _ red then
__ = ____
begin
_____
skrvtegn(if red then 62 else 29);
__ ____ ____
red := -, red
end;
___
skrvtegn(p3)
end for s;
___
LINE
end for r
___
end inner MAP-block;
___
LINE; LINE; LINE;
SHIFT(4);
skrvtegn(62);
skrvtekst(|<If you want more maps, then write a 1 here: |);
< >
r := tasttegn;
go_to if r = 1 then LL else RESTART
__ __ __ ____ ____
end of MAP-block;
___
LINEQ:
begin comment LINEQ-block;
_____ _______
integer N, i, j;
_______
SHIFT(10);
skrvtekst(|<Type 3. Solution of random linear equations.|);
< >
LINE; LINE;
if newlineq then
__ ____
begin
_____
SHIFT(5);
skrvtekst(|<
<
The program generates and solves a set of N random linear equations.
The maximum value of N is 24. Calculation time for N = 20 is 23 sec.
in ALGOL and 4 sec. in machine language. Specify N = 0 for stop.
|);
>
linerest := linerest - 4;
newlineq := false
_____
end if newlineq;
___
MM: LINE;
comment
_______
-14- DEMON
-1E
;
SHIFT(4);
skrvtekst(|<Specify N: |);
< >
N := tast;
LINE;
if N > 24 then N := 24;
__ ____
if N = 0 then go_to RESTART;
__ ____ __ __
begin comment inner LINEQ-block;
_____ _______
array x[1:N], MATRIX[1:N, 1:N + 1];
_____
procedure LINEQ1 (N, a, x, NOSOLUTION);
_________
integer N;
_______
array a, x;
_____
label NOSOLUTION;
_____
begin
_____
integer p, i, j;
_______
real M;
____
for p := 1 step 1 until N - 1 do
___ ____ _____ __
begin
_____
for i := p + 1 step 1 until N do
___ ____ _____ __
begin
_____
if a[p,p] | 0 then go_to L2;
__ = ____ __ __
if a[i,p] | 0 then go_to L1;
__ = ____ __ __
if i < N then go_to L3;
__ ____ __ __
go_to NOSOLUTION;
__ __
L1: for j := p step 1 until N + 1 do
___ ____ _____ __
begin
_____
M := a[p,j];
a[p,j] := a[i,j];
a[i,j] := M
end of row exchange;
___
go_to L3;
__ __
L2: if a[i,p] = 0 then go_to L3;
__ ____ __ __
M := -a[i,p]/a[p,p];
for j := p+1 step 1 until N+1 do
___ ____ _____ __
a[i,j] := a[i,j] + M⨯a[p,j];
L3: end for i;
___
end for p;
___
if a[N,N] = 0 then go_to NOSOLUTION;
__ ____ __ __
for p := N step -1 until 1 do
___ ____ _____ __
begin
_____
x[p] := a[p,N+1] := a[p,N+1]/a[p,p];
comment
_______
-15- DEMON-1
E
;
if p = 1 then go_to L4;
__ ____ __ __
for i := p-1 step -1 until 1 do
___ ____ _____ __
a[i,N+1] := a[i,N+1] - x[p]⨯a[i,p]
end for second p;
___
L4: end LINEQ-1;
___
NN: for i := 1 step 1 until N do
___ ____ _____ __
for j := 1 step 1 until N+1 do
___ ____ _____ __
MATRIX[i,j] := RANDOM(30000);
LINEQ1(N, MATRIX, x, ERROR);
go_to MM;
__ __
ERROR: SHIFT(4); LINE;
skrvtekst(|<Sorry, zero determinant. Here is another example.|);
< >
LINE;
go_to NN
__ __
end of inner LINEQ-block
___
end of LINEQ-block;
___
PRIME:
begin comment prime block;
_____ _______
boolean first, last, small;
_______
integer type, num, num1, fact, count, A, B;
_______
integer procedure PRIM1(x);
_______ _________
integer x;
_______
begin
_____
integer y;
_______
A: PRIM1 := x := x + 2;
y := 1;
for y := y + 2 while y⨯y_x do
___ _____ < __
if (x_y)⨯y = x then go_to A
__ : ____ __ __
end;
___
procedure READ(number, text);
_________
integer number;
_______
string text;
______
begin
_____
real N;
____
PP: SHIFT(4);
skrvtekst(text);
N := tast;
LINE;
if N < 1 ∨ N > 536870911 then go_to PP;
__ ____ __ __
comment
_______
-16- DEMON-1
E
;
number := N
end READ;
___
SHIFT(10);
skrvtekst(|<Type 4. Calculation of prime numbers.|);
< >
LINE; LINE;
if newprime then
__ ____
begin
_____
SHIFT(8);
skrvtekst(|<
<
The program contains two calculation types:
1. Calculation of prime factors in a specified number, N.
2. Calculation of primes in a specified range from A to B.
Specify type 3 for stop. Upper limit for numbers is 536870911.
|);
>
linerest := linerest - 5;
newprime := false
_____
end of newprime;
___
OO: LINE;
READ(type, |<Specify prime calculation type: |);
< >
if type = 1 then
__ ____
begin
_____
READ(num, |<Specify number, N: |);
< >
num1 := num;
first := true;
____
last := false;
_____
if num < 4 then
__ ____
QQ: begin
_____
skrvtekst(|<Prime|);
< >
go_to OO
__ __
end;
___
for fact := 2, 3, PRIM1(fact) while fact⨯fact _ num1 ∧ num > 1 do
___ _____ < __
begin
_____
count := 0;
RR: if num_fact⨯fact = num then
__ : ____
SS: begin
_____
count := count + 1;
num := num_fact;
:
if first then skrvtekst(|<=|);
__ ____ < >
if count = 1 then
__ ____
begin
_____
if -, first then skrvtekst(|<⨯|);
__ ____ < >
comment
_______
-17- DEMON-
1E
;
first := false;
_____
skrv(if fact < 10 then |d|
__ ____ < >
else if fact < 100 then |dd|
____ __ ____ < >
else if fact < 1000 then |ddd|
____ __ ____ < >
else if fact < 10000 then |dddd|
____ __ ____ < >
else |ddddddddd|, fact)
____ < >
end if count = 1;
___
go_to if last then OO else RR
__ __ __ ____ ____
end if divisor;
___
if count > 1 then
__ ____
begin
_____
skrvtekst(|<∧|);
< |>
skrv(if count < 10 then |d| else |dd|, count)
__ ____ < > ____ < >
end if power printing;
___
count := 0
end for fact;
___
if first then go_to QQ;
__ ____ __ __
last := true;
____
fact := num;
if num > 1 then go_to SS;
__ ____ __ __
go_to OO
__ __
end if type = 1
___
else
____
if type = 2 then
__ ____
begin
_____
READ(A, |<Specify lower limit, A: |);
< >
READ(B, |<Specify upper limit, B: |);
< >
small := B < 10000;
count := 0;
fact := if small then 10 else 8;
__ ____ ____
SHIFT(4);
if A = 1 then A := 2
__ ____
else
____
if A > 3 then
__ ____
begin
_____
A := A - (if A_2⨯2 = A then 1 else 2);
__ : ____ ____
UU: A := PRIM1(A)
end;
___
TT: if count_fact⨯fact = count then LINE;
__ : ____
count := count + 1;
if A_B then skrv(if small then |-ddddd| else |-ddddddddd|, A);
__ < ____ __ ____ < > ____ < >
comment
_______
-18- DEMON-1
E
;
if A < B then
__ ____
begin
_____
if A = 2 then
__ ____
begin
_____
A := 3;
go_to TT
__ __
end;
___
go_to UU
__ __
end;
___
go_to OO
__ __
end type = 2
___
else
____
go_to RESTART
__ __
end prime block;
___
LANU:
begin comment large number calculation block;
_____ _______
boolean first, out;
_______
integer M, carry, count, c1, c2, d1, d2, type, N, alimit, asize, nn, a,
_______
b, D, bsize, m;
procedure READ(number, text);
_________
integer number;
_______
string text;
______
begin
_____
SHIFT(4);
skrvtekst(text);
number := tast;
LINE
end READ;
___
procedure ALARM(n);
_________
value n;
_____
integer n;
_______
skrvtekst(|<
<
ERROR |, if n = 1 then |<1| else |<2|);
> __ ____ < > ____ < >
procedure MULT(n, A, size);
_________
value n;
_____
integer n, size;
_______
integer array A;
_______ _____
begin
_____
carry := 0;
comment
_______
-19- DEMON-
1E
;
for count := 0 step 1 until alimit do
___ ____ _____ __
begin
_____
c1 := A[count];
c2 := c1_M;
:
c1 := (c1-c2⨯M)⨯n + carry;
carry := c1_M;
:
c1 := c1 - carry⨯M;
c2 := c2⨯n + carry;
carry := c2_M;
:
A[count] := (c2-carry⨯M)⨯M + c1;
if count = size then
__ ____
begin
_____
if carry = 0 then go_to ex
__ ____ __ __
else
____
if count < alimit then size := size + 1
__ ____
else
____
ALARM(1)
end if count
___
end for count;
___
ex: end MULT;
___
procedure DIV(n, A, size, empty);
_________
value n;
_____
integer n, size;
_______
boolean empty;
_______
integer array A;
_______ _____
begin
_____
first := true;
____
carry := 0;
for count := size step -1 until 0 do
___ ____ _____ __
begin
_____
c1 := A[count];
c2 := c1_M;
:
c1 := c1 - c2⨯M;
carry := carry⨯M + c2;
c2 := carry_n;
:
carry := (carry - c2⨯n)⨯M + c1;
c1 := carry_n;
:
carry := carry - c1⨯n;
A[count] := c1 := c1 + c2⨯M;
comment
_______
-20- DEMON-
1E
;
if first then
__ ____
begin
_____
if c1 > 0 then first := false
__ ____ _____
else
____
if size > 0 then size := size - 1
__ ____
end if first
___
end for count;
___
empty := first ∧ c1 = 0
end DIV;
___
procedure ADD(plus, A, B, asize, bsize);
_________
value plus, bsize;
_____
boolean plus;
_______
integer asize, bsize;
_______
integer array A, B;
_______ _____
begin
_____
carry := 0;
for count := 0 step 1 until alimit do
___ ____ _____ __
begin
_____
c1 := A[count]; d1 := B[count];
c2 := c1_M; d2 := d1_M;
: :
c1 := c1-c2⨯M; d1 := d1 - d2⨯M;
c1 := c1 + (if plus then d1 else - d1) + carry;
__ ____ ____
carry := 0;
L1: if c1 < 0 then
__ ____
begin
_____
c1 := c1 + M;
carry := carry - 1;
go_to L1
__ __
end if c1 negative;
___
d1 := c1_M;
:
c1 := c1 - d1⨯M;
c2 := c2 + (if plus then d2 else - d2) + d1 + carry;
__ ____ ____
carry := 0;
L2: if c2 < 0 then
__ ____
begin
_____
c2 := c2 + M;
carry := carry - 1;
go_to L2
__ __
end if c2 negative;
___
d1 := c2_M;
:
comment
_______
-21- DEMON-1
E
;
c2 := c2 - d1⨯M;
carry := carry + d1;
A[count] := c1 := c1 + c2⨯M;
if count _ bsize ∧ carry = 0 then go_to L3
__ > ____ __ __
end for count;
___
if carry | 0 then ALARM(2);
__ = ____
L3: first := true;
____
for count := alimit step -1 until 0 do
___ ____ _____ __
begin
_____
asize := count;
if A[count] | 0 then go_to L4
__ = ____ __ __
end;
___
L4: end ADD;
___
procedure P4(n);
_________
value n;
_____
integer n;
_______
begin
_____
integer i, z, D, a;
_______
D := 1000;
z := if first then 0 else 16;
__ ____ ____
for i := 1 step 1 until 4 do
___ ____ _____ __
begin
_____
a := n_D;
:
n := n - a⨯D;
if a | 0 then
__ = ____
begin
_____
skrvtegn(a);
first := false;
_____
z := 16
end
___
else skrvtegn(z);
____
D := D_10
:
end for i
___
end P4;
___
procedure PR(A, size);
_________
value size;
_____
integer size;
_______
array A;
_____
begin
_____
first := true;
____
comment
_______
-22- DEMON-1
E
;
d1 := 0;
for count := size step -1 until 0 do
___ ____ _____ __
begin
_____
c1 := A[count];
c2 := c1_M;
:
c1 := c1 - c2⨯M;
P4(c2);
skrvml(1);
P4(c1);
skrvml(1);
d1 := d1 + 1;
if d1_8⨯8 = d1 then LINE
__ : ____
end for count
___
end PR;
___
SHIFT(10);
skrvtekst(|<Type 5. Calculation of large numbers.|);
< >
LINE; LINE;
if newlanu then
__ ____
begin
_____
SHIFT(8);
skrvtekst(|<
<
The program contains four calculation types:
1. Calculation of the factorial: FAC(N) = 1⨯2⨯3⨯4........⨯N.
2. Calculation of the power: a∧b.
|
3. Calculation of e = 2.718...... with D digits.
4. Calculation of pi = 3.1415.... with D digits.
5. gives program stop.
|);
>
linerest := linerest - 7;
newlanu := false
_____
end of newlanu;
___
LINE;
M := 10000;
VV: READ(type, |<Specify large number calculation type: |);
< >
if type = 1 then
__ ____
begin
_____
READ(N, |<Specify N:|);
< >
if N > 1000 then N := 1000;
__ ____
alimit := 0.05⨯N⨯ln(N);
begin
_____
integer array FAC[0:alimit];
_______ _____
comment
_______
-23- DEMON-
1E
;
for count := 0 step 1 until alimit do FAC[count] := 0;
___ ____ _____ __
asize := 0;
FAC[0] := 1;
for nn := 1 step 1 until N do MULT(nn, FAC, asize);
___ ____ _____ __
LINE; LINE;
SHIFT(4);
skrvtekst(|<FAC :=|);
< >
LINE;
PR(FAC, asize);
LINE;
go_to VV
__ __
end block
___
end if type = 1
___
else
____
if type = 2 then
__ ____
begin
_____
READ(a, |<Specify a: |);
< >
READ(b, |<Specify b: |);
< >
alimit := 1 + 0.055⨯b⨯ln(a);
begin
_____
integer array POT[0:alimit];
_______ _____
for count := 0 step 1 until alimit do POT[count] := 0;
___ ____ _____ __
asize := 0;
POT[0] := 1;
for nn := 1 step 1 until b do MULT(a, POT, asize);
___ ____ _____ __
LINE; LINE;
SHIFT(4);
skrvtekst(|<a∧b := |);
< | >
LINE;
PR(POT, asize);
LINE;
go_to VV
__ __
end block
___
end if type = 2
___
else
____
if type < 5 then
__ ____
begin
_____
READ(D, |<Specify D: |);
< >
alimit := D_8;
:
comment
_______
-24- DEMON-1E
;
if alimit⨯8 | D then
__ = ____
begin
_____
skrvtekst(|<D is changed to:|);
< >
alimit := alimit + 1;
D := 8⨯alimit;
skrv(|nddd|, D);
< >
LINE
end;
___
D := 8⨯alimit
end
___
else go_to RESTART;
____ __ __
if type = 3 then
__ ____
begin
_____
integer array RESULT, TERM[0:alimit];
_______ _____
for count := 0 step 1 until alimit do
___ ____ _____ __
RESULT[count] := TERM[count] := 0;
asize := bsize := alimit;
RESULT[alimit] := 2;
TERM[alimit] := 1;
out := false;
_____
m := 1;
for m := m + 1 while -, out do
___ _____ __
begin
_____
DIV(m, TERM, bsize, out);
ADD(true, RESULT, TERM, asize, bsize)
____
end for m;
___
LINE; LINE;
SHIFT(4);
skrvtekst(|<e⨯10∧D := |);
< | >
LINE;
PR(RESULT, asize);
LINE;
go_to VV
__ __
end block if type = 3
___
else
____
begin
_____
boolean out1, out2, out3, plus;
_______
integer t1size, t2size, t3size, ssize;
_______
integer array RESULT, T1, T2, T3, SUM[0:alimit];
_______ _____
comment
_______
-25- DEMON-1
E
;
for count := 0 step 1 until alimit do
___ ____ _____ __
RESULT[count] := T1[count] := T2[count] := T3[count] := 0;
T1[alimit] := T2[alimit] := T3[alimit] := 24;
asize := t1size := t2size := t3size := alimit;
DIV(8, T1, t1size, out1);
DIV(171, T2, t2size, out2);
DIV(1434, T3, t3size, out3);
plus := false;
_____
m := -1;
for m := m + 2 while -, out1 do
___ _____ __
begin
_____
for count := 0 step 1 until alimit do SUM[count] := 0;
___ ____ _____ __
ssize := 0;
ADD(true, SUM, T1, ssize, t1size);
____
if -, out2 then ADD(true, SUM, T2, ssize, t2size);
__ ____ ____
if -, out3 then ADD(true, SUM, T3, ssize, t3size);
__ ____ ____
DIV(m, SUM, ssize, out);
plus := -, plus;
ADD(plus, RESULT, SUM, asize, ssize);
DIV(64, T1, t1size, out1);
if -, out2 then DIV(3249, T2, t2size, out2);
__ ____
if -, out3 then for nn := 1,2 do DIV(239, T3, t3size, out3)
__ ____ ___ __
end for m;
___
LINE; LINE;
SHIFT(4);
skrvtekst(|<pi⨯10∧D :=|);
< | >
LINE;
PR(RESULT, asize);
LINE;
go_to VV
__ __
end type = 4
___
end LANU-block;
___
FINISH:
end of program DEMON-1E;
___
[ e n d ]
[ s t o p ]
comment
_______
-26- DEMON-1E
;
translate to ALGOL III (typein,typechar,char,writechar,write,
writetext,writecr);
end;
___
Jørgen Kjær[ s t o p ] 8