Richards.ns

Newspeak3
'Benchmarks'
class Richards usingPlatform: ignore = (
(* An OS kernel simulation benchmark, originally written in BCPL by Martin Richards.

This version derived from the Dart Ton80 version. *)
|
	DATA_SIZE = 4.
	COUNT = 1000.

	ID_IDLE = 1.
	ID_WORKER = 2.
	ID_HANDLER_A = 3.
	ID_HANDLER_B = 4.
	ID_DEVICE_A = 5.
	ID_DEVICE_B = 6.
	NUMBER_OF_IDS = 6.

	KIND_DEVICE = 0.
	KIND_WORK = 1.

	(* The task is running and is currently scheduled. *)
	STATE_RUNNING = 0.

	(* The task has packets left to process. *)
	STATE_RUNNABLE = 1.

	(* The task is not currently running. The task is not blocked as such and may be started by the scheduler. *)
	STATE_SUSPENDED = 2.

	(* The task is blocked and cannot be run until it is explicitly released. *)
	STATE_HELD = 4.
	STATE_SUSPENDED_RUNNABLE = STATE_SUSPENDED bitOr: STATE_RUNNABLE.
	STATE_NOT_HELD = STATE_HELD bitInvert.
|) (
class DeviceTask on: s = Task on: s (
(* A task that suspends itself after each time it has been run to simulate waiting for data from an external device. *)
|
protected pending <Packet>
|) (
public run: packet <Packet> ^<TaskControlBlock> = (
	packet isNil ifTrue:
		[ | functionWork <Packet> |
		pending isNil ifTrue: [^scheduler suspendCurrent].
		functionWork:: pending.
		pending:: nil.
		^scheduler queue: functionWork].
	pending:: packet.
	^scheduler holdCurrent
)
) : (
)
class HandlerTask on: s = Task on: s (
(* A task that manipulates work packets and then suspends itself. *)
|
	workIn <Packet>
	deviceIn <Packet>
|) (
public run: packet <Packet> ^<TaskControlBlock> = (
	packet isNil ifFalse:
		[packet kind = KIND_WORK
			ifTrue: [workIn:: packet appendTo: workIn]
			ifFalse: [deviceIn:: packet appendTo: deviceIn]].
	workIn isNil ifFalse:
		[ | v count = workIn datum. |
		count < DATA_SIZE
			ifTrue:
				[deviceIn isNil ifFalse:
					[v:: deviceIn.
					deviceIn:: deviceIn link.
					v datum: (workIn data at: count + 1 (* 1-origin conversion, sigh *)).
					workIn datum: (count + 1).
					^scheduler queue: v]]
			ifFalse:
				[v:: workIn.
				workIn:: workIn link.
				^scheduler queue: v]].
	^scheduler suspendCurrent
)
) : (
)
class IdleTask on: s with: ctrl with: cnt = Task on: s (
(* An idle task doesn't do any work itself but cycles control between the two device tasks. *)
|
protected control <Integer> ::= ctrl. (* A seed value that controls how the device tasks are scheduled. *)
protected count <Integer> ::= cnt. (* The number of times this task should be scheduled. *)
|) (
public run: packet <Packet> ^<TaskControlBlock> = (
	count:: count - 1.
	count = 0 ifTrue: [^scheduler holdCurrent].
	(control bitAnd: 1) = 0 ifTrue:
		[control:: control quo: 2.
		^scheduler release: ID_DEVICE_A].
	control:: (control quo: 2) bitXor: 16rD008.
	^scheduler release: ID_DEVICE_B
)
) : (
)
class Packet link: l identity: i kind: k = (
(* A simple package of data that is manipulated by the tasks.  The exact layout of the payload data carried by a packet is not importaint, and neither is the nature of the work performed on packets by the tasks. Besides carrying data, packets form linked lists and are hence used both as data and worklists. *)
|
public link <Packet> ::= l. (* The tail of the linked list of packets. *)
public identity <Integer> ::= i. (* An ID for this packet. *)
public kind <Integer> ::= k. (* The type of this packet. *)
public datum <Integer> ::= 0.
public data <Array[Integer]> = Array new: DATA_SIZE.
|) (
public appendTo: queueHead <Packet> ^<Packet> = (
	(* Add this packet to the end of a worklist, and return the worklist. *)
	| peek next |
	link: nil.
	queueHead isNil ifTrue: [^self].
	next: queueHead.
	[(peek:: next link) isNil]
		whileFalse: [next:: peek].
	next link: self.
   	^queueHead
)
) : (
)
class Scheduler = (
(* A scheduler can be used to schedule a set of tasks based on their relative priorities.  Scheduling is done by maintaining a list of task control blocks which holds tasks and the data queue they are processing. *)
|
	public queueCount <Integer> ::= 0.
	public holdCount <Integer> ::= 0.
	currentTcb <TaskControlBlock>
	currentId
	list <TaskControlBlock>
	blocks <Array[TaskControlBlock]> = Array new: NUMBER_OF_IDS.
|) (
public addDeviceTask: id <Integer> priority: priority <Integer> work: queue <Packet> = (
	(* Add a device task to this scheduler. *)
	addTask: id priority: priority work: queue task: (DeviceTask on: self).
)
public addHandlerTask: id <Integer> priority: priority <Integer> work: queue <Packet> = (
	(* Add a handler task to this scheduler. *)
	addTask: id priority: priority work: queue task: (HandlerTask on: self).
)
public addIdleTask: id <Integer> priority: priority <Integer> work: queue <Packet> state: count <Integer> = (
	(* Add an idle task to this scheduler. *)
	addRunningTask: id priority: priority work: queue task: (IdleTask on: self with: 1 with: count).
)
addRunningTask: id <Integer> priority: priority <Integer> work: queue <Packet> task: task <Task> = (
	addTask: id priority: priority work: queue task: task.
	currentTcb setRunning.
)
addTask: id <Integer> priority: priority <Integer> work: queue <Packet> task: task <Task> = (
	currentTcb:: TaskControlBlock link: list id: id priority: priority queue: queue task: task.
	list:: currentTcb.
	blocks at: id put: currentTcb.
)
public addWorkerTask: id <Integer> priority: priority <Integer> work: queue <Packet> = (
	(* Add a work task to this scheduler. *)
	addTask: id priority: priority work: queue task: (WorkerTask on: self with: ID_HANDLER_A with: 0).
)
public holdCurrent ^<TaskControlBlock> = (
	(* Block the currently executing task and return the next task control block to run.  The blocked task will not be made runnable until it is explicitly released, even if new work is added to it. *)
	holdCount:: holdCount + 1.
	currentTcb markAsHeld.
	^currentTcb link
)
public queue: packet <Packet> ^<TaskControlBlock> = (
	(* Add the specified packet to the end of the worklist used by the task associated with the packet and make the task runnable if it is currently suspended. *)
	| t = blocks at: packet identity. |
	t isNil ifTrue: [^t].
	queueCount:: queueCount + 1.
	packet link: nil.
	packet identity: currentId.
	^t addInput: packet checkPriority: currentTcb
)
public release: id <Integer> ^<TaskControlBlock> = (
	(* Release a task that is currently blocked and return the next block to run. *)
	| tcb = blocks at: id. |
	tcb isNil ifTrue: [^tcb].
	tcb markAsNotHeld.
	tcb priority > currentTcb priority ifTrue: [^tcb].
	^currentTcb
)
public schedule = (
	(* Execute the tasks managed by this scheduler. *)
	currentTcb:: list.
	[currentTcb isNil] whileFalse:
		[currentTcb isHeldOrSuspended
			ifTrue: [currentTcb:: currentTcb link]
			ifFalse: [currentId:: currentTcb identity.
					currentTcb:: currentTcb run]].
)
public suspendCurrent ^<TaskControlBlock> = (
	(* Suspend the currently executing task and return the next task control block to run. If new work is added to the suspended task it will be made runnable. *)
	currentTcb markAsSuspended.
	^currentTcb
)
) : (
)
class Task on: s = (
(* Abstract task that manipulates work packets. *)
|
protected scheduler <Scheduler> = s. (* The scheduler that manages this task. *)
|) (
public run: packet <Packet> = (
	subclassResponsibility
)
) : (
)
class TaskControlBlock link: l id: i priority: p queue: q task: t = (
(* A task control block manages a task and the queue of work packages associated with it. *)
|
	public link <TaskControlBlock> = l.
	public identity <Integer> = i.
	public priority <Integer> = p.
	queue <Packet> ::= q.
	task <Task> = t.
	state <Integer> ::= queue isNil ifTrue: [STATE_SUSPENDED] ifFalse: [STATE_SUSPENDED_RUNNABLE].
|) (
public addInput: packet <Packet> checkPriority: oldTask <Task> ^<TaskControlBlock> = (
	(* Adds a packet to the worklist of this block's task, marks this as runnable if necessary, and returns the next runnable object to run (the one with the highest priority. *)
	queue isNil
		ifTrue:
			[queue:: packet.
			self markAsRunnable.
			priority > oldTask priority ifTrue: [^self]]
		ifFalse:
			[queue:: packet appendTo: queue].
	^oldTask
)
public isHeldOrSuspended = (
	^((state bitAnd: STATE_HELD) = 0) not
		or: [state = STATE_SUSPENDED]
)
public markAsHeld = (
	state:: state bitOr: STATE_HELD.
)
public markAsNotHeld = (
	state:: state bitAnd: STATE_NOT_HELD.
)
public markAsRunnable = (
	state:: state bitOr: STATE_RUNNABLE.
)
public markAsSuspended = (
	state:: state bitOr: STATE_SUSPENDED.
)
public run ^<TaskControlBlock> = (
	(* Runs this task, if it is ready to be run, and returns the next task to run. *)
	| packet |
	state = STATE_SUSPENDED_RUNNABLE ifTrue: [
		packet:: queue.
		queue:: packet link.
		state:: queue isNil ifTrue: [STATE_RUNNING] ifFalse: [STATE_RUNNABLE].
	].
	^task run: packet
)
public setRunning = (
	state:: STATE_RUNNING.
)
) : (
)
class WorkerTask on: s with: v1 with: v2 = Task on: s (
(* A task that manipulates work packets. *)
|
protected destination <Integer> ::= v1.
protected count <Integer> ::= v2.
|) (
public run: packet <Packet> ^<TaskControlBlock> = (
	packet isNil ifTrue: [^scheduler suspendCurrent].
	destination = ID_HANDLER_A
		ifTrue: [destination:: ID_HANDLER_B]
		ifFalse: [destination:: ID_HANDLER_A].
	packet identity: destination.
	packet datum: 0.
	1 to: DATA_SIZE do: [:i |
		count:: count + 1.
		count > 26 ifTrue: [count:: 1].
		packet data at: i put: count.
	].
	^scheduler queue: packet
)
) : (
)
public bench = (
	| scheduler queue |

	scheduler:: Scheduler new.
	scheduler addIdleTask: ID_IDLE priority: 0 work: nil state: COUNT.
	queue:: Packet link: nil identity: ID_WORKER kind: KIND_WORK.
	queue:: Packet link: queue identity: ID_WORKER kind: KIND_WORK.
		scheduler addWorkerTask: ID_WORKER priority: 1000 work: queue.

	queue:: Packet link: nil identity: ID_DEVICE_A kind: KIND_DEVICE.
	queue:: Packet link: queue identity: ID_DEVICE_A kind: KIND_DEVICE.
	queue:: Packet link: queue identity: ID_DEVICE_A kind: KIND_DEVICE.
	scheduler addHandlerTask: ID_HANDLER_A priority: 2000 work: queue.

	queue:: Packet link: nil identity: ID_DEVICE_B kind: KIND_DEVICE.
	queue:: Packet link: queue identity: ID_DEVICE_B kind: KIND_DEVICE.
	queue:: Packet link: queue identity: ID_DEVICE_B kind: KIND_DEVICE.
	scheduler addHandlerTask: ID_HANDLER_B priority: 3000 work: queue.

	scheduler addDeviceTask: ID_DEVICE_A priority: 4000 work: nil.

	scheduler addDeviceTask: ID_DEVICE_B priority: 5000 work: nil.

	scheduler schedule.

	scheduler queueCount = 2322
		ifFalse: [Error signal: 'bad scheduler queue-count'].
	scheduler holdCount = 928
		ifFalse: [Error signal: 'bad scheduler hold-count'].
)
) : (
)