Richards:
PROGRAM
IMPORTS
BasicTime, PrincOpsUtils = {
z: UNCOUNTED ZONE; -- heap to use for packets and tasks
TaskNames
TaskIdentity:
TYPE =
MACHINE
DEPENDENT
{idler(1), worker, handlerA, handlerB, deviceA, deviceB};
Scheduler
Task: TYPE = LONG POINTER TO TaskControlBlock;
TaskControlBlock:
TYPE =
RECORD [
link: Task,
identity: TaskIdentity,
priority: TaskPriority,
input: WorkQueue,
state: TaskState,
function: TaskOperation,
handle: LONG POINTER];
TaskPriority: TYPE = CARDINAL;
TaskState:
TYPE =
RECORD [packetPending, taskWaiting, taskHolding:
BOOL ←
FALSE];
running: TaskState = [];
waiting: TaskState = [taskWaiting: TRUE];
waitingWithPacket: TaskState = [taskWaiting: TRUE, packetPending: TRUE];
TaskOperation:
TYPE =
PROC [work: WorkQueue, word:
LONG POINTER]
RETURNS [t: Task];
noTask: Task = NIL;
WorkQueue: TYPE = LONG POINTER TO Packet;
Packet:
TYPE =
RECORD [
link: WorkQueue,
identity: TaskIdentity,
kind: PacketKind,
datum: CARDINAL,
data:
ARRAY [0..packetBufferSize]
OF
CARDINAL];
PacketKind: TYPE = {devicePacketKind, workPacketKind};
packetBufferSize: CARDINAL = 3;
noWork: WorkQueue = NIL;
queuePacketCount: CARDINAL;
holdCount: CARDINAL;
taskTable: ARRAY TaskIdentity OF Task;
taskList: Task;
currentTask: Task;
currentTaskIdentity: TaskIdentity;
InitScheduler:
PROC [] = {
queuePacketCount ← holdCount ← 0;
allocWords ← allocObjects ← 0;
taskTable ← ALL[noTask];
taskList ← noTask;
};
CreateTask:
PROC
[identity: TaskIdentity, priority: TaskPriority, initialWorkQueue: WorkQueue, initialState: TaskState, function: TaskOperation, privateData: LONG POINTER] = {
t: Task ← z.
NEW[TaskControlBlock ← [
link: taskList,
identity: identity,
priority: priority,
input: initialWorkQueue,
state: initialState,
function: function,
handle: privateData]];
taskList ← t;
taskTable[identity] ← t;
};
CreatePacket:
PROC
[link: WorkQueue, identity: TaskIdentity, kind: PacketKind]
RETURNS [workQueue: WorkQueue] = {
workQueue ← z.
NEW[Packet ← [
link: link,
identity: identity,
kind: kind,
datum: 0,
data: ALL[0]]];
RETURN [workQueue];
};
QueuePacket:
PROC [packet: WorkQueue]
RETURNS [task: Task] = {
t: Task ← FindTask[packet.identity];
IF t = noTask THEN RETURN [noTask];
queuePacketCount ← queuePacketCount+1;
packet.link ← noWork;
packet.identity ← currentTaskIdentity;
IF t.input = noWork
THEN {
t.input ← packet;
t.state.packetPending ← TRUE;
IF t.priority > currentTask.priority THEN RETURN [t]
}
ELSE
Append[packet, @t.input];
RETURN [currentTask];
};
Append:
PROC [packet: WorkQueue, head:
LONG
POINTER
TO WorkQueue] = {
packet.link ← noWork;
IF head^ = noWork THEN {head^ ← packet; RETURN};
FOR mouse: WorkQueue ← head^, mouse.link
UNTIL mouse.link = noWork
DO
REPEAT
FINISHED => mouse.link ← packet
ENDLOOP;
};
Schedule:
PROC = {
message: WorkQueue;
currentTask ← taskList;
WHILE currentTask # noTask
DO
message ← noWork;
IF currentTask.state.taskHolding
OR currentTask.state = waiting
THEN currentTask ← currentTask.link
ELSE {
IF currentTask.state = waitingWithPacket
THEN {
message ← currentTask.input;
currentTask.input ← message.link;
IF currentTask.input = noWork
THEN currentTask.state ← running
ELSE currentTask.state ← [packetPending: TRUE]
};
currentTaskIdentity ← currentTask.identity;
currentTask ← currentTask.function[message, currentTask.handle];
};
ENDLOOP;
};
Wait:
PROC []
RETURNS [task: Task] = {
currentTask.state.taskWaiting ← TRUE;
RETURN [currentTask];
};
HoldSelf:
PROC []
RETURNS [task: Task] = {
holdCount ← holdCount+1;
currentTask.state.taskHolding ← TRUE;
RETURN [currentTask.link];
};
Release:
PROC [identity: TaskIdentity]
RETURNS [task: Task] = {
t: Task ← FindTask[identity];
IF t = noTask THEN RETURN [noTask];
t.state.taskHolding ← FALSE;
IF t.priority > currentTask.priority
THEN RETURN [t]
ELSE RETURN [currentTask];
};
FindTask:
PROC [identity: TaskIdentity]
RETURNS [task: Task] = {
t: Task ← taskTable[identity];
IF t = noTask THEN ERROR;
RETURN [t];
};
Idle
hashValue: CARDINAL = 0D008H;
IdleTaskDataRecord: TYPE = RECORD [control: WORD, count: CARDINAL];
IdleTaskData: TYPE = LONG POINTER TO IdleTaskDataRecord;
initialControl: WORD = 1;
CreateIdler:
PROC
[identity: TaskIdentity, priority: TaskPriority, work: WorkQueue, state: TaskState] = {
data: IdleTaskData ← z.NEW[IdleTaskDataRecord ← [initialControl, 10000]];
CreateTask[identity, priority, work, state, IdleFunction, data];
};
IdleFunction: TaskOperation = {
data: IdleTaskData ← word;
data.count ← data.count-1;
IF data.count = 0 THEN RETURN [HoldSelf[]];
IF PrincOpsUtils.
BITAND[data.control, 1] = 0
THEN {
data.control ← data.control/2;
RETURN [Release[deviceA]];
}
ELSE {
data.control ← PrincOpsUtils.BITXOR[data.control/2, hashValue];
RETURN [Release[deviceB]];
};
};
Devices
DeviceTaskDataRecord: TYPE = RECORD [pending: WorkQueue];
DeviceTaskData: TYPE = LONG POINTER TO DeviceTaskDataRecord;
CreateDevice:
PROC
[identity: TaskIdentity, priority: TaskPriority, work: WorkQueue, state: TaskState] = {
data: DeviceTaskData ← z.NEW[DeviceTaskDataRecord ← [noWork]];
CreateTask[identity, priority, work, state, DeviceFunction, data];
};
DeviceFunction: TaskOperation = {
data: DeviceTaskData ← word;
IF work = noWork
THEN {
IF data.pending = noWork THEN RETURN [Wait[]];
work ← data.pending;
data.pending ← noWork;
RETURN [QueuePacket[work]]
}
ELSE {
data.pending ← work;
RETURN [HoldSelf[]]
};
};
Handle
HandlerTaskDataRecord: TYPE = RECORD [workIn, deviceIn: WorkQueue];
HandlerTaskData: TYPE = LONG POINTER TO HandlerTaskDataRecord;
CreateHandler:
PROC
[identity: TaskIdentity, priority: TaskPriority, work: WorkQueue, state: TaskState] = {
data: HandlerTaskData ← z.NEW[HandlerTaskDataRecord ← [noWork, noWork]];
CreateTask[identity, priority, work, state, HandlerFunction, data];
};
HandlerFunction: TaskOperation = {
data: HandlerTaskData ← word;
workPacket, devicePacket: WorkQueue;
count: INTEGER;
IF work # noWork
THEN
IF work.kind = workPacketKind
THEN Append[work, @data.workIn]
ELSE Append[work, @data.deviceIn];
IF data.workIn # noWork
THEN {
workPacket ← data.workIn;
count ← workPacket.datum;
IF count > packetBufferSize
THEN {
data.workIn ← data.workIn.link;
RETURN [QueuePacket[workPacket]];
};
IF data.deviceIn # noWork
THEN {
devicePacket ← data.deviceIn;
data.deviceIn ← data.deviceIn.link;
devicePacket.datum ← workPacket.data[count];
workPacket.datum ← count+1;
RETURN [QueuePacket[devicePacket]]
};
};
RETURN [Wait[]];
};
Working
WorkerTaskDataRecord: TYPE = RECORD [destination: TaskIdentity, count: CARDINAL];
WorkerTaskData: TYPE = LONG POINTER TO WorkerTaskDataRecord;
CreateWorker:
PROC
[identity: TaskIdentity, priority: TaskPriority, work: WorkQueue, state: TaskState] = {
data: WorkerTaskData ← z.NEW[WorkerTaskDataRecord ← [handlerA, 0]];
CreateTask[identity, priority, work, state, WorkFunction, data];
};
WorkFunction: TaskOperation = {
data: WorkerTaskData ← word;
IF work = noWork
THEN RETURN [Wait[]]
ELSE {
data.destination ←
(IF data.destination = handlerA THEN handlerB ELSE handlerA);
work.identity ← data.destination;
work.datum ← 0;
FOR i:
CARDINAL
IN [0..packetBufferSize]
DO
data.count ← data.count+1;
IF data.count > 26 THEN data.count ← 1;
work.data[i] ← ('A-0C)+data.count-1;
ENDLOOP;
RETURN [QueuePacket[work]];
};
};
Main:
PROC
RETURNS [time:
REAL] = {
workQ: WorkQueue;
pulses: BasicTime.Pulses = BasicTime.GetClockPulses[];
InitScheduler[];
CreateIdler[idler, 0, noWork, running];
workQ ← CreatePacket[noWork, worker, workPacketKind];
workQ ← CreatePacket[workQ, worker, workPacketKind];
CreateWorker[worker, 1000, workQ, waitingWithPacket];
workQ ← CreatePacket[noWork, deviceA, devicePacketKind];
workQ ← CreatePacket[workQ, deviceA, devicePacketKind];
workQ ← CreatePacket[workQ, deviceA, devicePacketKind];
CreateHandler[handlerA, 2000, workQ, waitingWithPacket];
workQ ← CreatePacket[noWork, deviceB, devicePacketKind];
workQ ← CreatePacket[workQ, deviceB, devicePacketKind];
workQ ← CreatePacket[workQ, deviceB, devicePacketKind];
CreateHandler[handlerB, 2000, workQ, waitingWithPacket];
CreateDevice[deviceA, 4000, noWork, waiting];
CreateDevice[deviceB, 5000, noWork, waiting];
Schedule[];
IF queuePacketCount # 23246 THEN ERROR Bogus;
IF holdCount # 9297 THEN ERROR Bogus;
IF allocObjects # 20 THEN ERROR Bogus;
IF allocWords # 140 THEN ERROR Bogus;
time ← BasicTime.PulsesToSeconds[BasicTime.GetClockPulses[] - pulses];
};
The following procedure is used to implement the uncounted zone. We are quite sneaky here, but it does not really matter.
Alloc:
PROC [z:
UNCOUNTED
ZONE, words:
CARDINAL]
RETURNS [
LONG
POINTER] = {
index: CARDINAL ← allocWords;
allocObjects ← allocObjects + 1;
allocWords ← allocWords + words;
RETURN [@allocBase[index]];
};
allocObjects: CARDINAL ← 0;
allocWords: CARDINAL ← 0;
AllocRef: TYPE = REF AllocBlock;
AllocBlock: TYPE = RECORD [rest: SEQUENCE words: NAT OF CARDINAL];
allocBase: AllocRef ← NEW[AllocBlock[256]];
allocPtr: PROC ANY RETURNS ANY ← Alloc;
allocPtrPtr: LONG POINTER ← LOOPHOLE[LONG[@allocPtr]];
z ←
LOOPHOLE[
LONG[@allocPtrPtr]];
Yucchhhh!!! This is necessary but disgusting!
}...