Using BCPL coroutines to implement object oriented-like functionality. (Performance isn't too bad either)

gistfile1.txt

GET "libhdr"

// Define the message selectors for our "object-oriented" interface.

MANIFEST {
  MSG_INIT = 1; MSG_FREE;
  MSG_TICK;
  MSG_GET_COUNT;
  MSG_GO_DOWN;
  MSG_GO_UP;
}

LET start() = VALOF {
  LET theCounter = ?

  writef("I'm about to perform some tests with coroutines.*n")
  writef("First, I'm going to make an up-counter object.*n")

  theCounter := make_counter()
  UNLESS theCounter DO writef("No memory for upcounter.*n") <> stop(20, 103)

  writef("The counter should be at zero.  Let's count it a few times.*n")
  do_ticks(theCounter, (TABLE 4, 1, 2, 3, 4), 10)

  writef("Now, I'm going to alter the *"type*" of the object to be a down-counter.*n")
  send_message(theCounter, MSG_GO_DOWN)

  writef("We should be able to count some more.*n")
  do_ticks(theCounter, (TABLE 3, 1, 2, 3), 4)

  writef("Now, switching back to upcounter mode.*n")
  send_message(theCounter, MSG_GO_UP)
  do_ticks(theCounter, (TABLE 2, 1, 2), 7)

  free_counter(theCounter)
}

AND do_ticks(aCounter, tickList, finalCount) BE {
  FOR i = 1 TO tickList!0 DO {
    send_message(aCounter, MSG_TICK, tickList!i)
    writef("Counter = %n*n", send_message(aCounter, MSG_GET_COUNT))
  }
  writef("(Should now be at %n.)*n", finalCount)
}

AND send_message(obj, msgtype, a,b,c,d,e,f,g,h) = send_request(@obj)
AND send_request(msg) = callco(msg!0, msg)

AND make_counter() = initco(up_counter_main, 1000, 0, MSG_INIT)

AND free_counter(c) BE {
  IF c DO {
    send_message(c, MSG_FREE)
    deleteco(c)
  }
}

AND up_counter_main(pmsg) BE {
  LET typ, arg, result = ?, ?, ?
  LET counter = ?       // Object state

  {
    IF pmsg DO {
      typ := pmsg!1
      arg := pmsg!2

      SWITCHON typ INTO {
      CASE MSG_INIT:    // (Re)construct the object!
        counter := 0
        ENDCASE

      CASE MSG_FREE:    // nothing to destruct
        ENDCASE

      CASE MSG_TICK:
        counter := counter + arg
        ENDCASE

      CASE MSG_GET_COUNT:
        result := counter
        ENDCASE

      CASE MSG_GO_DOWN:
        counter := down_counter_main(counter)
        ENDCASE

      CASE MSG_GO_UP:
        // We're already here!
        ENDCASE

      DEFAULT:
        writef("Huh?  Message type %n received, but I don't know what to do with it.*n", typ)
        stop(20, 1000)
      }
    }

    pmsg := cowait(result)
  } REPEAT

}

AND down_counter_main(old_counter) = VALOF {
  LET typ, arg, result = ?, ?, 0
  LET counter = old_counter
  LET pmsg, done = ?, FALSE

  WHILE ~done DO {
    pmsg := cowait(result)
    IF pmsg DO {
      typ := pmsg!1
      arg := pmsg!2

      SWITCHON typ INTO {
      CASE MSG_INIT:    // (Re)construct the object!
        counter := 0
        ENDCASE

      CASE MSG_FREE:    // nothing to destruct
        ENDCASE

      CASE MSG_TICK:
        counter := counter - arg
        ENDCASE

      CASE MSG_GET_COUNT:
        result := counter
        ENDCASE

      CASE MSG_GO_DOWN:
        // Do nothing; we're already here!
        ENDCASE

      CASE MSG_GO_UP:
        // Switch back to up-counter mode.
        done := TRUE
        ENDCASE

      DEFAULT:
        writef("Huh?  Message type %n received, but I don't know what to do with it.*n", typ)
        stop(20, 1000)
      }
    }
  }

  RESULTIS counter
}