
<<Richards.mesa>>
<<Copyright © 1984 by Xerox Corporation.  All rights reserved.>>
<<Martin Richards' benchmark program transcribed from BCPL>>
<<via Modula version by Peter Robinson of Fri May 20 14:55:00 1983>>
<<modified for Dragon comparison by Russ Atkinson, July 19, 1984 11:29:27 pm PDT >>
    <<Pradeep Sindhu October 22, 1985 3:18:22 pm PDT>>

DIRECTORY
BasicTime,
PrincOpsUtils USING [BITAND, BITXOR];

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: PUBLIC 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];
<<>>
};

Bogus: ERROR = CODE;

<<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!>>

}...