diff --git a/service/Makefile b/service/Makefile index 23c21d0..6921165 100644 --- a/service/Makefile +++ b/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 diff --git a/service/build.sh b/service/build.sh new file mode 100755 index 0000000..746f7a5 --- /dev/null +++ b/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} diff --git a/service/infarray.lisp b/service/infarray.lisp new file mode 100644 index 0000000..1a3ad1d --- /dev/null +++ b/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)) diff --git a/service/main.lisp b/service/main.lisp index 4027761..d3a489a 100644 --- a/service/main.lisp +++ b/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") diff --git a/service/server.lisp b/service/server.lisp index bcef432..f417b8e 100644 --- a/service/server.lisp +++ b/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*)) diff --git a/service/test/infarray-test.lisp b/service/test/infarray-test.lisp new file mode 100644 index 0000000..e7fc2f4 --- /dev/null +++ b/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) diff --git a/service/tetris.asd b/service/tetris.asd index 8c754e2..ccd238a 100644 --- a/service/tetris.asd +++ b/service/tetris.asd @@ -13,7 +13,9 @@ :description "A restful service on top of tetris-ai" :license "GPLv3" :author "Ernesto Alfonso " - :components ((:file "server") + :components ( + (:file "infarray") + (:file "server") (:file "ws") (:file "util") (:file "main")) diff --git a/service/ws.lisp b/service/ws.lisp index e6f1e35..14fd591 100644 --- a/service/ws.lisp +++ b/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))))))) diff --git a/service/www/js/tetris_client.js b/service/www/js/tetris_client.js index 2b47aa1..ffc63aa 100755 --- a/service/www/js/tetris_client.js +++ b/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)); }; diff --git a/src/ai.c b/src/ai.c index 7e57d41..82569c6 100644 --- a/src/ai.c +++ b/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 );