1295 - broken snapshot

I spent a couple of hours debugging this because routine-state only
sometimes writes to its product. This is unacceptable. Fix this first.

5 files changed, 301 insertions, 10 deletions

diff --git a/020run.cc b/020run.cc
index d8fdcf55..2cbfdc45 100644
--- a/020run.cc
+++ b/020run.cc
@@ -55,6 +55,7 @@ void run_current_routine()
     if (current_instruction().is_label) { ++current_step_index(); continue; }
     trace("run") << "instruction " << current_recipe_name() << '/' << current_step_index();
     trace("run") << current_instruction().to_string();
+    assert(Memory[0] == 0);
 //?     trace("run") << Memory[1033] << '\n'; //? 1
 //?     cout << "operation " << current_instruction().operation << '\n'; //? 3
     switch (current_instruction().operation) {
diff --git a/026assert.cc b/026assert.cc
index 6ab49db2..b736e1cd 100644
--- a/026assert.cc
+++ b/026assert.cc
@@ -11,6 +11,7 @@ ASSERT,
 Recipe_number["assert"] = ASSERT;
 :(before "End Primitive Recipe Implementations")
 case ASSERT: {
+  assert(!current_instruction().ingredients.empty());
   trace("run") << "ingredient 0 is " << current_instruction().ingredients[0].name;
   vector<long long int> arg0 = read_memory(current_instruction().ingredients[0]);
   assert(arg0.size() == 1);
diff --git a/038scheduler.cc b/038scheduler.cc
index bc04d91c..63d30f75 100644
--- a/038scheduler.cc
+++ b/038scheduler.cc
@@ -50,7 +50,7 @@ void run(recipe_number r) {
 //?     cout << "scheduler: " << Current_routine_index << '\n'; //? 1
     assert(Current_routine);
     assert(Current_routine->state == RUNNING);
-    trace("schedule") << current_recipe_name();
+    trace("schedule") << "switching to " << Current_routine->id << ": " << current_recipe_name();
     run_current_routine(Scheduling_interval);
     if (Current_routine->completed())
       Current_routine->state = COMPLETED;
@@ -231,11 +231,39 @@ Recipe_number["routine-state"] = ROUTINE_STATE;
 :(before "End Primitive Recipe Implementations")
 case ROUTINE_STATE: {
   vector<long long int> result;
+  assert(!current_instruction().ingredients.empty());
+  assert(!read_memory(current_instruction().ingredients[0]).empty());
+  index_t target_id = read_memory(current_instruction().ingredients[0])[0];
+  cout << "routine-state: looking for " << target_id << '\n';
+  index_t target_index = 0;
+  for (index_t target_index = 0; target_index < Routines.size(); ++target_index) {
+    cout << "routine: " << Routines[target_index]->id << '\n';
+    if (Routines[target_index]->id == target_id) break;
+  }
+  if (target_index < Routines.size()) {
+    cout << "routine-state: " << Routines[target_index]->id << ": " << Routines[target_index]->state << '\n';
+    cout << "dest: " << current_instruction().products[0].to_string() << '\n';
+    cout << "before: " << Memory[current_instruction().products[0].value] << '\n';
+    result.push_back(Routines[target_index]->state);
+  }
+  else {
+    result.push_back(-1);
+  }
+  write_memory(current_instruction().products[0], result);
+  cout << "after: " << Memory[current_instruction().products[0].value] << '\n';
+  break;
+}
+
+:(before "End Primitive Recipe Declarations")
+RESTART,
+:(before "End Primitive Recipe Numbers")
+Recipe_number["restart"] = RESTART;
+:(before "End Primitive Recipe Implementations")
+case RESTART: {
   index_t id = read_memory(current_instruction().ingredients[0])[0];
   for (index_t i = 0; i < Routines.size(); ++i) {
     if (Routines[i]->id == id) {
-      result.push_back(Routines[i]->state);
-      write_memory(current_instruction().products[0], result);
+      Routines[i]->state = RUNNING;
       break;
     }
   }
diff --git a/039wait.cc b/039wait.cc
index 940cba89..b6d4fc18 100644
--- a/039wait.cc
+++ b/039wait.cc
@@ -41,6 +41,7 @@ case WAIT_FOR_LOCATION: {
   Current_routine->waiting_on_location = loc.value;
   Current_routine->old_value_of_wating_location = Memory[loc.value];
   trace("run") << "waiting for location " << loc.value << " to change from " << Memory[loc.value];
+  trace("schedule") << Current_routine->id << ": waiting for location " << loc.value << " to change from " << Memory[loc.value];
   break;
 }
 
@@ -48,16 +49,21 @@ case WAIT_FOR_LOCATION: {
 
 :(before "End Scheduler State Transitions")
 for (index_t i = 0; i < Routines.size(); ++i) {
+  trace("schedule") << "wake up loop 1: routine " << Routines[i]->id << " has state " << Routines[i]->state;
   if (Routines[i]->state != WAITING) continue;
-  if (Memory[Routines[i]->waiting_on_location] &&
+  trace("schedule") << "waiting on location: " << Routines[i]->waiting_on_location;
+  if (Routines[i]->waiting_on_location)
+    trace("schedule") << "checking routine " << Routines[i]->id << " waiting on location "
+      << Routines[i]->waiting_on_location << ": " << Memory[Routines[i]->waiting_on_location] << " vs " << Routines[i]->old_value_of_wating_location;
+  if (Routines[i]->waiting_on_location &&
       Memory[Routines[i]->waiting_on_location] != Routines[i]->old_value_of_wating_location) {
-    trace("schedule") << "waking up routine\n";
+    trace("schedule") << Current_routine->id << ": waking up routine " << Routines[i]->id << " waiting on location " << Routines[i]->waiting_on_location;
     Routines[i]->state = RUNNING;
     Routines[i]->waiting_on_location = Routines[i]->old_value_of_wating_location = 0;
   }
 }
 
-//: also allow waiting on a routine
+//: also allow waiting on a routine to stop running
 
 :(scenario wait_for_routine)
 recipe f1 [
@@ -89,18 +95,22 @@ case WAIT_FOR_ROUTINE: {
   Current_routine->state = WAITING;
   Current_routine->waiting_on_routine = loc.value;
   trace("run") << "waiting for routine " << loc.value;
+  trace("schedule") << Current_routine->id << ": waiting for routine " << loc.value;
   break;
 }
 
 :(before "End Scheduler State Transitions")
+// Wake up any routines waiting for other routines to go to sleep.
+// Important: this must come after the scheduler loop above giving routines
+// waiting for locations to change a chance to wake up.
 for (index_t i = 0; i < Routines.size(); ++i) {
   if (Routines[i]->state != WAITING) continue;
   if (!Routines[i]->waiting_on_routine) continue;
-  index_t id = Routines[i]->waiting_on_routine;
-  assert(id != i);
+  index_t target = Routines[i]->waiting_on_routine;
+  assert(target != i);
   for (index_t j = 0; j < Routines.size(); ++j) {
-    if (Routines[j]->id == id && Routines[j]->state != WAITING) {
-      trace("schedule") << "waking up routine\n";
+    if (Routines[j]->id == target && Routines[j]->state != RUNNING) {
+      trace("schedule") << "waking up routine " << Routines[i]->id << " waiting on routine " << target;
       Routines[i]->state = RUNNING;
       Routines[i]->waiting_on_routine = 0;
     }
diff --git a/chessboard.mu b/chessboard.mu
index d4b00b6f..a252242f 100644
--- a/chessboard.mu
+++ b/chessboard.mu
@@ -1,3 +1,7 @@
+# chessboard program: takes moves in algebraic notation and displays the
+# position after each
+
+## a board is an array of files, a file is an array of characters (squares)
 recipe init-board [
   default-space:address:array:location <- new location:type, 30:literal
   initial-position:address:array:integer <- next-ingredient
@@ -140,3 +144,250 @@ scenario printing-the-board [
     .                              .
   ]
 ]
+
+## data structure: move
+container move [
+  # valid range: 0-7
+  from-file:integer
+  from-rank:integer
+  to-file:integer
+  to-rank:integer
+]
+
+recipe read-move [
+  default-space:address:array:location <- new location:type, 30:literal
+  stdin:address:channel <- next-ingredient
+  from-file:integer <- read-file stdin:address:channel
+  {
+    q-pressed?:boolean <- lesser-than from-file:integer, 0:literal
+    break-unless q-pressed?:boolean
+    reply 0:literal
+  }
+  # construct the move object
+  result:address:move <- new move:literal
+  x:address:integer <- get-address result:address:move/deref, from-file:offset
+  x:address:integer/deref <- copy from-file:integer
+  x:address:integer <- get-address result:address:move/deref, from-rank:offset
+  x:address:integer/deref <- read-rank stdin:address:channel
+  expect-from-channel stdin:address:channel, 45:literal  # '-'
+  x:address:integer <- get-address result:address:move/deref, to-file:offset
+  x:address:integer/deref <- read-file stdin:address:channel
+  x:address:integer <- get-address result:address:move/deref, to-rank:offset
+  x:address:integer/deref <- read-rank stdin:address:channel
+  expect-from-channel stdin:address:channel, 10:literal  # newline
+  reply result:address:move
+]
+
+recipe read-file [
+  default-space:address:array:location <- new location:type, 30:literal
+  stdin:address:channel <- next-ingredient
+  c:character, stdin:address:channel <- read stdin:address:channel
+  {
+    q-pressed?:boolean <- equal c:character, 81:literal  # 'q'
+    break-unless q-pressed?:boolean
+    reply -1:literal
+  }
+  file:integer <- subtract c:character, 97:literal  # 'a'
+  # 'a' <= file <= 'h'
+  above-min:boolean <- greater-or-equal file:integer, 0:literal
+  assert above-min:boolean [file too low]
+  below-max:boolean <- lesser-than file:integer, 8:literal
+  assert below-max:boolean [file too high]
+  reply file:integer
+]
+
+recipe read-rank [
+  default-space:address:array:location <- new location:type, 30:literal
+  stdin:address:channel <- next-ingredient
+  c:character, stdin:address:channel <- read stdin:address:channel
+  {
+    q-pressed?:boolean <- equal c:character, 81:literal  # 'q'
+    break-unless q-pressed?:boolean
+    reply -1:literal
+  }
+  rank:integer <- subtract c:character, 49:literal  # '1'
+  # assert'1' <= rank <= '8'
+  above-min:boolean <- greater-or-equal rank:integer 0:literal
+  assert above-min:boolean [rank too low]
+  below-max:boolean <- lesser-or-equal rank:integer 7:literal
+  assert below-max:boolean [rank too high]
+  reply rank:integer
+]
+
+# read a character from the given channel and check that it's what we expect
+recipe expect-from-channel [
+  default-space:address:array:location <- new location:type, 30:literal
+  stdin:address:channel <- next-ingredient
+  expected:character <- next-ingredient
+  c:character, stdin:address:channel <- read stdin:address:channel
+  match?:boolean <- equal c:character, expected:character
+  assert match?:boolean [expected character not found]
+]
+
+scenario read-move-blocking [
+  run [
+#?     $start-tracing #? 2
+    1:address:channel <- init-channel 1:literal
+    2:integer/routine <- start-running read-move:recipe, 1:address:channel
+    # 'read-move' is waiting for input
+    wait-for-routine 2:integer
+    3:integer <- routine-state 2:integer/id
+    $print [routine ]
+    $print 2:integer/routine
+    $print [ state ]
+    $print 3:integer
+    $print [
+]
+    waiting?:integer <- equal 3:integer/routine-state, 2:literal/waiting
+    assert waiting?:integer/routine-state, [
+F read-move-blocking: routine failed to pause after coming up (before any keys were pressed)]
+    # press 'a'
+    1:address:channel <- write 1:address:channel, 97:literal  # 'a'
+    restart 2:integer/routine
+    # 'read-move' still waiting for input
+    wait-for-routine 2:integer
+    3:integer <- routine-state 2:integer/id
+    $print [routine ]
+    $print 2:integer/routine
+    $print [ state ]
+    $print 3:integer
+    $print [
+]
+    waiting?:integer <- equal 3:integer/routine-state, 2:literal/waiting
+    $print [=======
+]
+    assert waiting?:integer/routine-state, [
+F read-move-blocking: routine failed to pause after rank 'a']
+    # press '2'
+    1:address:channel <- write 1:address:channel, 50:literal  # '2'
+    restart 2:integer/routine
+    # 'read-move' still waiting for input
+    wait-for-routine 2:integer
+    3:integer <- routine-state 2:integer/id
+    $print [aaa: ]
+    $print [routine ]
+    $print 2:integer/routine
+    $print [ state ]
+    $print 3:integer
+    $print [
+]
+    waiting?:integer <- equal 3:integer/routine-state, 2:literal/waiting
+    assert waiting?:integer/routine-state, [
+F read-move-blocking: routine failed to pause after file 'a2']
+    # press '-'
+    1:address:channel <- write 1:address:channel, 45:literal  # '-'
+    restart 2:integer/routine
+    # 'read-move' still waiting for input
+    wait-for-routine 2:integer
+    3:integer <- routine-state 2:integer
+    $print 3:integer
+    $print [
+]
+    waiting?:integer <- equal 3:integer/routine-state, 2:literal/waiting
+    assert waiting?:integer/routine-state, [
+F read-move-blocking: routine failed to pause after hyphen 'a2-']
+    # press 'a'
+    1:address:channel <- write 1:address:channel, 97:literal  # 'a'
+    restart 2:integer/routine
+    # 'read-move' still waiting for input
+    wait-for-routine 2:integer
+    3:integer <- routine-state 2:integer
+    $print 3:integer
+    $print [
+]
+    waiting?:integer <- equal 3:integer/routine-state, 2:literal/waiting
+    assert waiting?:integer/routine-state, [
+F read-move-blocking: routine failed to pause after rank 'a2-a']
+    # press '4'
+    1:address:channel <- write 1:address:channel, 52:literal  # '4'
+    restart 2:integer/routine
+    # 'read-move' still waiting for input
+    wait-for-routine 2:integer
+    3:integer <- routine-state 2:integer
+    $print 3:integer
+    $print [
+]
+    waiting?:integer <- equal 3:integer/routine-state, 2:literal/waiting
+    assert waiting?:integer/routine-state, [
+F read-move-blocking: routine failed to pause after file 'a2-a4']
+    # press 'newline'
+    1:address:channel <- write 1:address:channel, 10:literal  # newline
+    restart 2:integer/routine
+    # 'read-move' now completes
+    wait-for-routine 2:integer
+    3:integer <- routine-state 2:integer
+    $print 3:integer
+    $print [
+]
+    completed?:integer <- equal 3:integer/routine-state, 1:literal/completed
+    assert completed?:integer/routine-state, [
+F read-move-blocking: routine failed to terminate on newline]
+  ]
+]
+
+#? recipe make-move [
+#?   default-space:space-address <- new space:literal 30:literal
+#?   b:board-address <- next-input
+#?   m:address:move <- next-input
+#?   x:integer-integer-pair <- get m:address:move/deref from:offset
+#?   from-file:integer <- get x:integer-integer-pair 0:offset
+#?   from-rank:integer <- get x:integer-integer-pair 1:offset
+#?   f:file-address <- index b:board-address/deref from-file:integer
+#?   src:square-address <- index-address f:file-address/deref from-rank:integer
+#?   x:integer-integer-pair <- get m:address:move/deref to:offset
+#?   to-file:integer <- get x:integer-integer-pair 0:offset
+#?   to-rank:integer <- get x:integer-integer-pair 1:offset
+#?   f:file-address <- index b:board-address/deref to-file:integer
+#?   dest:square-address <- index-address f:file-address/deref to-rank:integer
+#?   dest:square-address/deref <- copy src:square-address/deref
+#?   src:square-address/deref <- copy #\_ literal
+#?   reply b:board-address
+#? ]
+#? 
+#? recipe chessboard [
+#?   default-space:space-address <- new space:literal 30:literal
+#?   initial-position:integer-array-address <- init-array #\R literal #\P literal #\_ literal #\_ literal #\_ literal #\_ literal #\p literal #\r literal
+#?                                                         #\N literal #\P literal #\_ literal #\_ literal #\_ literal #\_ literal #\p literal #\n literal
+#?                                                         #\B literal #\P literal #\_ literal #\_ literal #\_ literal #\_ literal #\p literal #\b literal
+#?                                                         #\Q literal #\P literal #\_ literal #\_ literal #\_ literal #\_ literal #\p literal #\q literal
+#?                                                         #\K literal #\P literal #\_ literal #\_ literal #\_ literal #\_ literal #\p literal #\k literal
+#?                                                         #\B literal #\P literal #\_ literal #\_ literal #\_ literal #\_ literal #\p literal #\b literal
+#?                                                         #\N literal #\P literal #\_ literal #\_ literal #\_ literal #\_ literal #\p literal #\n literal
+#?                                                         #\R literal #\P literal #\_ literal #\_ literal #\_ literal #\_ literal #\p literal #\r literal
+#?   b:board-address <- init-board initial-position:integer-array-address
+#?   cursor-mode
+#?   # hook up stdin
+#?   stdin:address:channel <- init-channel 1:literal
+#?   fork-helper send-keys-to-stdin:fn nil:literal/globals nil:literal/limit nil:literal/keyboard stdin:address:channel
+#?   # buffer stdin
+#?   buffered-stdin:address:channel <- init-channel 1:literal
+#?   fork-helper buffer-lines:fn nil:literal/globals nil:literal/limit stdin:address:channel buffered-stdin:address:channel
+#?   $print "Stupid text-mode chessboard. White pieces in uppercase# black pieces in lowercase. No checking for legal moves." literal
+#?   cursor-to-next-line nil:literal/terminal
+#?   { begin
+#?     cursor-to-next-line nil:literal/terminal
+#?     print-board nil:literal/terminal b:board-address
+#?     cursor-to-next-line nil:literal/terminal
+#?     $print "Type in your move as <from square>-<to square>. For example: 'a2-a4'. Then press <enter>." literal
+#?     cursor-to-next-line nil:literal/terminal
+#?     $print "Hit 'q' to exit." literal
+#?     cursor-to-next-line nil:literal/terminal
+#?     $print "move: " literal
+#?     m:address:move <- read-move buffered-stdin:address:channel
+#? #?     retro-mode #? 1
+#? #?     $print stdin:address:channel #? 1
+#? #?     $print "\n" literal #? 1
+#? #?     $print buffered-stdin:address:channel #? 1
+#? #?     $print "\n" literal #? 1
+#? #?     $dump-memory #? 1
+#? #?     cursor-mode #? 1
+#?     break-unless m:address:move
+#?     b:board-address <- make-move b:board-address m:address:move
+#?     loop
+#?   }
+#?   retro-mode
+#? ]
+#? 
+#? recipe main [
+#?   chessboard
+#? ]