/
life.pir
278 lines (247 loc) · 4.57 KB
/
life.pir
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
# Copyright (C) 2001-2008, The Perl Foundation.
# $Id$
=head1 NAME
examples/pir/life.pir - Conway's Life
=head1 SYNOPSIS
% ./parrot examples/pir/life.pir
=head1 DESCRIPTION
Runs Conway's Life cellular automata
(L<http://ddi.cs.uni-potsdam.de/HyFISCH/Produzieren/lis_projekt/proj_gamelife/ConwayScientificAmerican.htm>).
=head1 TODO
Convert this into proper PIR.
=head1 SEE ALSO
F<examples/library/ncurses_life.pir>.
=cut
.sub 'life' :main
.param pmc argv
.local int max_generations
# First the generation count
I15 = argv
if I15 < 2 goto USE_DEFAULT_MAX_GENERATIONS
S5 = argv[1]
I2 = S5
print "Running "
print I2
print " generations.\n"
goto MAX_GENERATIONS_IS_NOW_KNOWN
USE_DEFAULT_MAX_GENERATIONS:
print "Running 5000 generations by default.\n"
set I2, 5000
MAX_GENERATIONS_IS_NOW_KNOWN:
print "\n"
# Note the time
time N5
# If true, we don't print
set I12, 0
set S0, " "
set S1, " "
set S2, " "
set S3, " "
set S4, " ** "
set S5, " * * "
set S6, " * "
set S7, " * * "
set S8, " ****** "
set S9, " "
set S10, " "
set S11, " "
set S12, " "
set S13, " "
set S14, " "
set S15, ""
concat S15, S0
concat S15, S1
concat S15, S2
concat S15, S3
concat S15, S4
concat S15, S5
concat S15, S6
concat S15, S7
concat S15, S8
concat S15, S9
concat S15, S10
concat S15, S11
concat S15, S12
concat S15, S13
concat S15, S14
bsr dump
set I0, 0
loop: ge I0, I2, getout
inc I0
mod I31,I0,100
if I31, skip
printerr "."
skip:
bsr generate
bsr dump
branch loop
getout: time N6
sub N7, N6, N5
print "\n"
print I2
print " generations in "
print N7
print " seconds. "
set N8, I2
div N1, N8, N7
print N1
print " generations/sec\n"
interpinfo I1, 1
print "A total of "
print I1
print " bytes were allocated\n"
interpinfo I1, 2
print "A total of "
print I1
print " DOD runs were made\n"
interpinfo I1, 3
print "A total of "
print I1
print " collection runs were made\n"
interpinfo I1, 10
print "Copying a total of "
print I1
print " bytes\n"
interpinfo I1, 5
print "There are "
print I1
print " active Buffer structs\n"
interpinfo I1, 7
print "There are "
print I1
print " total Buffer structs\n"
end
# S15 has the incoming string, S0 is scratch, S1 is scratch, S2 is scratch
#
# I0 is the length of the string
# I1 is the current cell we're checking
# I2 is the count for that cell
# I3 is the offset to the neighbor
generate:
.local int save_I0, save_I1, save_I2, save_I3
save_I0 = I0
save_I1 = I1
save_I2 = I2
save_I3 = I3
length I0, S15
set S1, ""
set I1, 0
genloop:
set I2, 0
NW:
set I3, -16
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
# S0 is always overwritten, so reuse it
substr_r S0, S15, I3, 1
ne S0, "*", North
inc I2
North:
set I3, -15
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
substr_r S0, S15, I3, 1
ne S0, "*", NE
inc I2
NE:
set I3, -14
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
substr_r S0, S15, I3, 1
ne S0, "*", West
inc I2
West:
set I3, -1
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
substr_r S0, S15, I3, 1
ne S0, "*", East
inc I2
East:
set I3, 1
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
substr_r S0, S15, I3, 1
ne S0, "*", SW
inc I2
SW:
set I3, 14
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
substr_r S0, S15, I3, 1
ne S0, "*", South
inc I2
South:
set I3, 15
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
substr_r S0, S15, I3, 1
ne S0, "*", SE
inc I2
SE:
set I3, 16
add I3, I3, I0
add I3, I3, I1
mod I3, I3, I0
substr_r S0, S15, I3, 1
ne S0, "*", check
inc I2
check:
substr_r S0, S15, I1, 1
eq S0, "*", check_alive
# If eq 3, put a star in else a space
check_dead:
eq I2, 3, star
branch space
check_alive:
lt I2, 2, space
gt I2, 3, space
branch star
space:
concat S1, " "
branch iter_done
star:
concat S1, "*"
iter_done:
inc I1
lt I1, I0, genloop
done:
set S15, S1
I3 = save_I3
I2 = save_I2
I1 = save_I1
I0 = save_I0
ret
# S15 has the incoming string, S0 is scratch
dump:
if I12, dumpend
print "\f"
print "\n\n\n\n\n\n\n\n\n\n\n"
print "------------- generation "
print I0
print " -------------\n"
set I10, 0
set I11, 14
printloop:
substr_r S0, S15, I10, 15
print S0
print "\n"
add I10, I10, 15
dec I11
ge I11, 0, printloop
sleep 1
dumpend:
ret
.end
# Local Variables:
# mode: pir
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4 ft=pir: