|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 7112 (0x1bc8)
Description: Bits:30000871 Algol standard procedure: integersort
Types: 8-hole paper tape
Notes: Gier Text
; rc 26.04.71 algol standard procedure integersort, page 1
; procedure integersort (a, n); integer array a; integer n;
; comment: the procedure sorts the n first elements of the array a
; into ascending order. if n is greater than the number of elements
; in a then the whole array is sorted.
; restriction: all odd elements, which take part in the sorting, are
; made even by subtraction of a one, i.e. the last bit of the elements
; are set to 0.
; the method: is a simplified implementation of quicksort (see algo-
; rithms 63, 64, and 271, comm acm).
; the main difference is that the partition value, t, is chosen so that
; the segment beeing partioned contains at least one element < t and
; one > t (unless all elements have the same value in which case they
; already are sorted). whenever a segment contains 4 or fewer elements
; it is sorted by simple exchanges;
b. e2, g1 ;
w. ;
s. c1, g2, j3;
k=10000 ;
h. ;
g0:e0: g1, g1;
j0: 13, 0 ; rs-entry 13 last used
j1: 30, 0 ; - - 30 save w3 and stackref
j2: 4, 0 ; - - 4 take expression
j3: 8, 0 ; - - 8 end address expression
g1=k-2-g0 ;
w. ;
e1: 0 ;
0 ;
27 04 71 ;
10 00 00 ;
[ s t o p ]
; rc 26.04.71 algol standard procedure integersort, page 2
e2: rl. w2 (j0.) ; integersort:
ds. w3 (j1.) ; treat the parameters:
dl w1 x2+12 ;
so w0 16 ;
jl. w3 (j2.) ;
ds. w3 (j1.) ;
dl w3 x2+8 ;
rl w0 x3 ;
ba w3 4 ;
rl w2 x1 ; j:= n;
wa w2 x1 ;
sh w2 0 ; if j < 1 then
jl. (j3.) ; goto end address expression;
wa w2 x3 ;
sl w2 (x3-2) ; if j > number of elements then
rl w2 x3-2 ; j:= number of elements;
wa w2 0 ; w2:= abs address (a(j));
rl w1 x3 ; i:= 1;
al w1 x1+2 ; w1:= abs address (a(i));
wa w1 0 ;
jl. w3 c0. ; make even (a, i, j);
jl. w3 c1. ; intsort (a, i, j);
jl. (j3.) ; goto end address expression;
b. a2, b0; subroutine make even (x1, x2);
w. ; comment the words from x1 to x2;
b0: 0 ; save return
c0: rs. w3 b0. ;
al w3 x1 ;
al w0 -2 ;
jl. a2. ;
a0: la w0 x3 ;
rs w0 x3 ;
al w0 -2 ;
a1: sn w3 x2 ;
jl. (b0.) ;
al w3 x3+2 ;
a2: so w0 (x3) ;
jl. a0. ;
jl. a1. ;
e. ; end make even
[ s t o p ]
; rc 26.04.71 algol standard procedure integersort, page 3
b. a14,b2; subroutine intsort (x1, x2);
w. ; comment the words from x1 to x2;
c1: rs. w3 b1. ; intsort: save return;
al. w3 b0. ; curr1:= stackbase;
jl. a5. ; goto start;
a1: rl w0 x1 ; exchange:
rx w0 x2 ;
rs w0 x1 ; swop (a(i),a(j));
a2: al w1 x1+2 ; up: i:= i+1;
; partition:
a3: sl w3 (x1) ; if a(i) <= t then
jl. a2. ; goto up;
a4: al w2 x2-2 ; down: j:= j-1;
sh w3 (x2) ; if a(j) >= t then
jl. a4. ; goto down;
sh w1 x2 ; if i < j then
jl. a1. ; goto exchange;
rl. w3 b2. ; partition completed:
rl w0 x3 ; curr1:= curr;
wa w0 x3-2 ;
am x1 ; if ist(curr1) + jst(curr1) >= i + j
sl w0 x2 ; then
rx w1 x3-2 ; swop(i,ist(curr1))
sl w1 x2+1 ; else
rx w2 x3 ; swop(j,jst(curr1));
a5: al w3 x3+4 ; start: curr1 := curr1 + 1;
sl w1 x2-6 ; if i >= j-3 then
jl. a13. ; goto simple sort;
ds w2 x3 ; ist(curr1):= i; jst(curr1):= j;
a6: rs. w3 b2. ; next partition: curr:= curr1;
rl w0 x1 ; compute t:
sn w0 (x2) ; if a(i) = a(j) then
jl. a8. ; search first differing
rl w3 x2 ; else t:= a(j);
a7: as w3 -1 ;
as w0 -1 ; t:=
wa w3 0 ; a(i)//2 + t//2;
al w2 x2+2 ; j:= j+1;
jl. a3. ; goto partition;
a8: al w2 x2-2 ; search first differing:
sn w2 x1 ; j:= j-1;
jl. a12. ; if i=j then goto unstack;
sn w0 (x2) ; if a(i) = a(j) then
jl. a8. ; goto search first differing;
rl w3 x2 ; t:= a(j);
rl. w2 (b2.) ; j:= jst(curr);
jl. a7. ; end then;
[ s t o p ]
; rc 26.04.71 algol standard procedure integersort, page 4
a9: rl w0 x1+6 ; sort4:
sh w0 (x1+4) ;
rx w0 x1+4 ;
sh w0 (x1+2) ;
rx w0 x1+2 ;
sh w0 (x1) ;
rx w0 x1 ;
rs w0 x1+6 ;
a10: rl w0 x1+4 ; sort3:
sh w0 (x1+2) ;
rx w0 x1+2 ;
sh w0 (x1) ;
rx w0 x1 ;
rs w0 x1+4 ;
a11: rl w0 x1+2 ; sort2:
sh w0 (x1) ;
rx w0 x1 ;
rs w0 x1+2 ;
a12: al w3 x3-4 ; no sort: unstack: curr1:= curr-1;
sh. w3 b0. ; if curr1 <= stackbase then
jl. (b1.) ; return;
dl w2 x3 ; i:= ist(curr1); j:= jst(curr1);
sh w1 x2-8 ; if i <= j-4 then
jl. a6. ; goto next partition;
a13: ws w2 2 ; simple sort:
jl. x2+a14. ; goto case j-i of
a14: jl. a12. ; (no sort,
jl. a11. ; sort2,
jl. a10. ; sort3,
jl. a9. ; sort4);
b1: 0 ; save return
b2: 0 ; curr
b0=k-2; stackbase
k=k+64; reserve 16 stackeelements: ist(1:16) and jst(i:16)
i. ;
e. ; end int sort
[ s t o p ]
; rc 26.04.71 algol standard procedure integersort, page 5
g2=k-g0 ;
c.g2-506;
m.code on segment too long
z. ;
c.502-g2,0,r.252-g2>1 z.;
<:integersort<0>:> ;
i. ;
e. ;
g0: g1: ; tailpart
1 ;
0, r.4 ;
1<23+e2-e0 ;
1<18+3<12+25<6 , 0; procedure (integer array, integer)
4<12+e1-e0 ;
1<12 ;
m. rc 26.04.71 integersort
[ s t o p ] [ e n d ]