examples/pir/life.pir

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