Fix oom

service/Makefile

@@ -1,9 +1,7 @@
 SHELL=/bin/bash
 
-
 all:
 	mkdir -p bin
-	buildapp --eval '(declaim (optimize (speed 3)))' --eval '(load #p"~/quicklisp/setup.lisp")' --eval '(load #p"tetris.asd")' --eval "(ql:quickload 'tetris-ai-rest)" --entry tetris-ai-rest:main --output bin/tetris-ai-rest
-
+	./build.sh bin/tetris-ai-rest
 clean:
 	rm -r bin

service/build.sh

@@ -0,0 +1,13 @@
+#!/bin/bash -x
+
+set -euo pipefail
+
+OUT=${1:-tetris-ai-rest}
+
+buildapp --eval '(declaim (optimize (speed 3)))' \
+         --eval '(load #p"~/quicklisp/setup.lisp")' \
+         --eval '(load #p"tetris.asd")' \
+         --eval "(ql:quickload 'tetris-ai-rest)" \
+         --eval "(disable-debugger)" \
+         --entry tetris-ai-rest:main  \
+         --output ${OUT}

service/infarray.lisp

@@ -0,0 +1,43 @@
+(defpackage #:tetris-ai-rest/infarray
+  (:use :cl)
+  (:export
+   #:infarray-new
+   #:infarray-nth
+   #:infarray-push)
+  (:documentation "an infinite array that only remembers the last n elements"))
+
+(in-package #:tetris-ai-rest/infarray)
+
+(defstruct infarray
+  page
+  len
+  page-len)
+
+(defun infarray-new (element-type &key (max-elements 10000000))
+  (assert (>= max-elements 2))
+  (make-infarray
+   :page-len max-elements
+   :page (make-array max-elements :element-type element-type)
+   :len 0))
+
+(defun infarray-nth (infarray nth)
+  (with-slots (page len page-len)
+      infarray
+    (if (or (< nth 0) (>= nth len))
+        (values nil :out-of-bounds)
+        (let ((oldest-idx (- len page-len)))
+          (if (< nth oldest-idx)
+              (values nil :forgotten)
+              (values (aref page (mod nth page-len))))))))
+
+(defun infarray-push (infarray elt)
+  (with-slots (page page-len len)
+      infarray
+    (let ((idx (mod len page-len)))
+      (setf (aref page idx) elt)
+      (when (zerop idx)
+        (sb-ext:gc :full t))
+      (incf len))))
+
+(defun infarray-length (infarray)
+  (infarray-len infarray))

service/main.lisp

@@ -12,6 +12,7 @@
      "dimensions of the grid, in the form of HxW, e.g. 19x10")
     (("ai-depth" #\d) :type integer :optional t :documentation "libtetris ai depth")
     (("default-ai-move-delay-millis" #\m) :type integer :optional t :documentation "delay between ai moves")
+    (("max-remembered-moves" #\M) :type integer :optional t :documentation "max moves to remember")
     (("log-filename" #\l) :type string :optional t :documentation "filename where to log connections")
     (("verbose" #\v) :type boolean :optional t :documentation "verbose logging")
     (("help" #\h) :type boolean :optional t :documentation "display help")

service/server.lisp

@@ -27,7 +27,12 @@
    #:service-config
    #:grid-height-width
    #:config-grid-height-width
-   #:game-serialize-state))
+   #:game-serialize-state)
+  (:import-from #:tetris-ai-rest/infarray
+                #:infarray-new
+                #:infarray-nth
+                #:infarray-length
+                #:infarray-push))
 
 (in-package #:tetris-ai-rest)
 
@@ -42,6 +47,7 @@
   (max-move-catchup-wait-secs 10)
   (ai-depth 3)
   (default-ai-move-delay-millis 5)
+  (max-remembered-moves 10000000);; 10 million
   (log-filename "tetris-ai-rest.log"))
 
 (defstruct service
@@ -53,9 +59,7 @@
 
 (defstruct game-execution
   game
-  (moves (make-array 0 :adjustable t
-                     :fill-pointer t
-                     :element-type 'tetris-ai:game-move))
+  (moves (infarray-new 'tetris-ai:game-move))
   last-recorded-state
   running-p
 
@@ -158,31 +162,26 @@ The capturing behavior is based on wrapping `ppcre:register-groups-bind'
 
 (defun game-exc-move (game-exc move-no &aux moves)
   (setf moves (game-execution-moves game-exc))
-  (cond
-    ((< move-no (length moves)) ;; test this first, even if redundant
-     (values hunchentoot:+HTTP-OK+ (aref moves move-no)))
-
-    ((not (game-execution-running-p game-exc))
-     (values hunchentoot:+HTTP-REQUESTED-RANGE-NOT-SATISFIABLE+
-             '(:error "requested move outside of range of completed game")))
-
-    (t
-     (loop with
-        max-move-catchup-wait-secs = (config-max-move-catchup-wait-secs
-                                      (service-config *service*))
-        for i below max-move-catchup-wait-secs
-        as behind = (>= move-no (length moves))
-        while behind
-        do (progn
-             (vom:debug "catching up from ~D to ~D (~D secs left)~%"
-                        (length moves) move-no (- max-move-catchup-wait-secs i))
-             (sleep 1))
-        finally
-          (return
-            (if behind
-                (values hunchentoot:+HTTP-SERVICE-UNAVAILABLE+
-                        '(:error "reached timeout catching up to requested move" ))
-                (values hunchentoot:+HTTP-OK+ (aref moves move-no))))))))
+  (multiple-value-bind (move err) (infarray-nth moves move-no)
+    (cond
+      ((null err) (values hunchentoot:+HTTP-OK+ move))
+      ((eq err :forgotten) '(:error "the requested move has been forgotten by the service"))
+      ((not (game-execution-running-p game-exc))
+       (assert (eq err :out-of-bounds))
+       (values hunchentoot:+HTTP-REQUESTED-RANGE-NOT-SATISFIABLE+
+               '(:error "requested move outside of range of completed game")))
+      (t (loop
+            ;; blocking wait to allow ai thread to catch up...
+            with max-move-catchup-wait-secs = (config-max-move-catchup-wait-secs
+                                               (service-config *service*))
+            for i below max-move-catchup-wait-secs
+            do (vom:debug "catching up from ~D to ~D (~D secs left)~%"
+                          (infarray-length moves) move-no (- max-move-catchup-wait-secs i))
+            thereis (multiple-value-bind (move err) (infarray-nth moves move-no)
+                      (and (null err) (values hunchentoot:+HTTP-OK+ move)))
+            finally
+              (return (values hunchentoot:+HTTP-SERVICE-UNAVAILABLE+
+                              '(:error "reached timeout catching up to requested move"))))))))
 
 (define-regexp-route game-move-handler ("^/games/([0-9]+)/moves/([0-9]+)$"
                                         (#'parse-integer game-no) (#'parse-integer move-no))
@@ -231,7 +230,7 @@ until either the game is lost, or `max-moves' is reached"
            (progn
              (unless (zerop ai-move-delay-secs)
                (sleep ai-move-delay-secs))
-             (vector-push-extend native moves)))
+             (infarray-push moves native)))
        if (zerop (mod i last-recorded-state-check-multiple))
        do
          (setf (game-execution-last-recorded-state game-exc)
@@ -247,7 +246,8 @@ until either the game is lost, or `max-moves' is reached"
   (unless (service-running-p *service*)
     (error "service not running"))
 
-  (with-slots (ai-depth grid-height-width default-ai-move-delay-millis ai-weights-file)
+  (with-slots (ai-depth grid-height-width default-ai-move-delay-millis
+                        ai-weights-file max-remembered-moves)
       (service-config *service*)
     (let* ((game (destructuring-bind (height . width)
                      grid-height-width
@@ -258,13 +258,15 @@ until either the game is lost, or `max-moves' is reached"
                                         :ai-depth ai-depth)))
            (game-exc (apply 'make-game-execution
                             :game game
+                            :moves (infarray-new 'tetris-ai:game-move
+                                                 :max-elements max-remembered-moves)
                             :last-recorded-state (game-serialize-state game 0)
 
                             (append make-game-exc-extra-args
                                     (list :ai-move-delay-secs
                                           (/ default-ai-move-delay-millis 1000)))))
            (exc-table (service-game-executions *service*))
-           (game-no (HASH-TABLE-SIZE exc-table)))
+           (game-no (HASH-TABLE-COUNT exc-table)))
 
       (assert (service-game-executions *service*))
 

service/test/infarray-test.lisp

@@ -0,0 +1,49 @@
+(defpackage #:tetris-ai-infarray-test
+  ;; (:use :cl :lisp-unit)
+  (:use :cl)
+  (:import-from #:stefil
+                #:is)
+  (:import-from #:tetris-ai-rest/infarray
+                #:infarray-new
+                #:infarray-nth
+                #:infarray-length
+                #:infarray-push)
+  (:export #:run-tests))
+
+(in-package #:tetris-ai-infarray-test)
+
+(stefil:deftest infarray-test nil
+  (let* ((infarr (infarray-new (type-of 11) :max-elements 10)))
+    (labels ((is-nth-ok (nth elt-exp)
+               (multiple-value-bind (elt err)
+                   (infarray-nth infarr nth)
+                 (is (eq elt elt-exp))
+                 (is (null err))))
+             (is-nth-err (nth err-exp)
+               (multiple-value-bind (elt err) (infarray-nth infarr nth)
+                 (is (eq err err-exp))
+                 (is (null elt)))))
+
+      (is (eq 0 (infarray-length infarr)))
+      (is-nth-err 0 :out-of-bounds)
+      (is-nth-err -1 :out-of-bounds)
+      (infarray-push infarr 0)
+      (is (eq 1 (infarray-length infarr)))
+      (is-nth-ok 0 0)
+      (is-nth-err -1 :out-of-bounds)
+
+      (loop for i from 1 below 10
+         do (infarray-push infarr i)
+         do (is (eq (1+ i) (infarray-length infarr)))
+         do (loop for ii upto i do
+                 (is-nth-ok ii ii)))
+
+      (loop for i from 10 below 100
+         do (infarray-push infarr i)
+         do (is (eq (1+ i) (infarray-length infarr)))
+         do (loop for ii upto i do
+                 (if (< (- i ii) 10)
+                     (is-nth-ok ii ii)
+                     (is-nth-err ii :forgotten)))))))
+
+(infarray-test)

service/tetris.asd

@@ -13,7 +13,9 @@
   :description "A restful service on top of tetris-ai"
   :license "GPLv3"
   :author "Ernesto Alfonso <erjoalgo@gmail.com>"
-  :components ((:file "server")
+  :components (
+               (:file "infarray")
+               (:file "server")
                (:file "ws")
                (:file "util")
                (:file "main"))

service/ws.lisp

@@ -61,7 +61,7 @@
          (game-exc (exc-resource/game-exc res)))
     (multiple-value-bind (ret-code data) (game-exc-move game-exc move-no)
       (if (not (= 200 ret-code))
-          (clws:write-to-client-binary client (- ret-code))
+          (clws:write-to-client-text client (write-to-string (- ret-code)))
           (let* ((game-move data)
                  (packed (tetris-ai:game-move-pack game-move)))
             (clws:write-to-client-text client (write-to-string packed)))))))

service/www/js/tetris_client.js

@@ -443,16 +443,18 @@ Game.prototype.fetchCallback = function(move) {
 Game.prototype.fetch = function() {
     // send request to fetch the next block and the AI best move
     var game = this;
+    var fetch;
     if (this.ws != null) {
-        return new Promise(function(resolve, reject) {
+        fetch = new Promise(function(resolve, reject) {
             game.ws.resolve = resolve;
             game.ws.reject = reject;
             game.ws.send(game.moveNo);
         });
     } else {
         var uri = "/games/" + this.gameNo + "/moves/" + this.moveNo;
-        return serverRequest(uri).then(fetchCallback, gameOver);
+        fetch = serverRequest(uri);
     }
+    return fetch.then(this.fetchCallback.bind(this));
 };
 
 Game.prototype.init = function(gameNo) {
@@ -533,13 +535,16 @@ Game.prototype.initWs = function(ws_url){
         state.ws = new WebSocket(state.ws_url);
         state.ws.addEventListener('message', function(event) {
             var packed = event.data;
-            // if (packed<0)    {state.ws.reject();}
-            var answer = state.answer;
-            answer.m = (packed >> 16) & 0xff;
-            answer.r = (packed >> 8) & 0xff;
-            answer.x = (packed >> 0) & 0xff;
-            state.fetchCallback(answer);
-            state.ws.resolve();
+            if (packed<0)    {
+                var status_code = -packed;
+                state.ws.reject("bad status code from server: "+status_code);
+            } else  {
+                var answer = state.answer;
+                answer.m = (packed >> 16) & 0xff;
+                answer.r = (packed >> 8) & 0xff;
+                answer.x = (packed >> 0) & 0xff;
+                state.ws.resolve(answer);
+            }
         });
         state.ws.addEventListener('open', function(event) {
             console.log("ws connection opened..");
@@ -686,9 +691,8 @@ Game.prototype.gameOver = function() {
 
 Game.prototype.fetchPlanExecuteLoop = function() {
     // a recursive promise to continuously fetch, plan, execute
-    var game = this;
-    this.fetch()
-        .then(this.ui.paintTo.bind(this.ui, game.b, ON)) // add active block to the UI
+    return this.fetch()
+        .then(this.ui.paintTo.bind(this.ui, this.b, ON)) // add active block to the UI
         .then(this.planExecute.bind(this))
         .then(this.fetchPlanExecuteLoop.bind(this));
 };

src/ai.c

@@ -40,7 +40,8 @@ double* load_weights ( char* file )    {
     memset(seen, 0, sizeof(seen));
 
     char feat_name[21];
-    for ( int i = 0; i < FEAT_COUNT; i++ )    {
+    int i;
+    for ( i = 0; i < FEAT_COUNT; i++ )    {
       double wi;
       if (fscanf(fh, "%20s\t%lf", feat_name, &wi) != 2)    {
         sprintf(err, "found %d weights in %s but wanted %d\n", i, file, FEAT_COUNT );